Fix recursive deletion in ghcup nuke

.cirrus.yml

@@ -1,25 +0,0 @@
-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

@@ -1,37 +0,0 @@
-.
-./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

@@ -1,31 +0,0 @@
-.
-./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

@@ -1,81 +0,0 @@
-.
-./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

@@ -1,16 +0,0 @@
-#!/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

@@ -1,76 +0,0 @@
-#!/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

@@ -1,172 +0,0 @@
-#!/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

@@ -1,73 +0,0 @@
-#!/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

@@ -1,66 +0,0 @@
-#!/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

@@ -1,263 +0,0 @@
-#!/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

@@ -1,48 +0,0 @@
-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

@@ -1,37 +0,0 @@
-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

@@ -1,68 +0,0 @@
-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

@@ -1,26 +0,0 @@
-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

@@ -1,33 +0,0 @@
-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,460 +1,109 @@
-name: Build and release
+name: Create Release
 
 on:
   push:
-    branches:
-      - master
     tags:
       - 'v*'
-  pull_request:
-    branches:
-      - master
-  schedule:
-    - cron: '0 2 * * *'
 
 jobs:
-  build-linux:
-    name: Build linux binary
+  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
     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 }}
+      MACOSX_DEPLOYMENT_TARGET: 10.13
     strategy:
-      fail-fast: true
       matrix:
-        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
+        os:
+          - macOS-10.15
     steps:
       - name: Checkout code
-        uses: actions/checkout@v3
+        uses: actions/checkout@v2
+
+      - uses: haskell/actions/setup@v1.2
         with:
-          submodules: 'true'
+          ghc-version: 8.10.7
+          cabal-version: 3.6.2.0
 
-      - if: matrix.ARCH == '32'
-        name: Run build (32 bit linux)
-        uses: docker://hasufell/i386-alpine-haskell:3.12
-        with:
-          args: sh .github/scripts/build.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: Alpine
-          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
-          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
-          S3_HOST: ${{ env.S3_HOST }}
-
-      - if: matrix.ARCH == '64'
-        name: Run build (64 bit linux)
-        uses: docker://hasufell/alpine-haskell:3.12
-        with:
-          args: sh .github/scripts/build.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: Alpine
-          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
-          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
-          S3_HOST: ${{ env.S3_HOST }}
-
-      - if: always()
-        name: Upload artifact
-        uses: actions/upload-artifact@v3
-        with:
-          name: artifacts
-          path: |
-            ./out/*
-
-
-  build-arm:
-    name: Build ARM binary
-    runs-on: ${{ matrix.os }}
-    env:
-      CABAL_VER: 3.6.2.0
-      JSON_VERSION: "0.0.7"
-      AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
-      AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
-      S3_HOST: ${{ secrets.S3_HOST }}
-    strategy:
-      fail-fast: true
-      matrix:
-        include:
-          - os: [self-hosted, Linux, aarch64]
-            ARTIFACT: "armv7-linux-ghcup"
-            GHC_VER: 8.10.7
-            ARCH: ARM
-          - os: [self-hosted, Linux, aarch64]
-            ARTIFACT: "aarch64-linux-ghcup"
-            GHC_VER: 8.10.7
-            ARCH: ARM64
-    steps:
-      - uses: docker://arm64v8/ubuntu:focal
-        name: Cleanup (aarch64 linux)
-        with:
-          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
-
-      - name: git config
-        run: |
-          git config --global --get-all safe.directory | grep '^\*$' || git config --global --add safe.directory "*"
+      - name: create ~/.local/bin
+        run: mkdir -p "$HOME/.local/bin"
         shell: bash
 
-      - name: Checkout code
-        uses: actions/checkout@v3
-        with:
-          submodules: 'true'
+      - name: Add ~/.local/bin to PATH
+        run: echo "$HOME/.local/bin" >> $GITHUB_PATH
+        shell: bash
 
-      - 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 }}
+      - name: Update cabal cache
+        run: cabal update
+        shell: bash
 
-      - if: matrix.ARCH == 'ARM64'
-        uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
-        name: Run build (aarch64 linux)
-        with:
-          args: sh .github/scripts/build.sh
+      - 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
         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 }}
+          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
+        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
 
       - if: always()
-        name: Upload artifact
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v2
         with:
-          name: artifacts
-          path: |
-            ./out/*
+          name: plan.json
+          path: ./dist-newstyle/cache/plan.json
 
-  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

@@ -1,28 +0,0 @@
-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

.gitlab-ci.yml

@@ -206,7 +206,7 @@ variables:
     # otherwise we seem to get intel binaries
     - export HOMEBREW_CHANGE_ARCH_TO_ARM=1
     # update and install packages
-    - /bin/bash ./.gitlab/script/brew.sh llvm autoconf automake coreutils
+    - /bin/bash ./.gitlab/script/brew.sh llvm autoconf automake
     # extract cabal cache
     - ./.gitlab/script/ci.sh extract_cabal_cache
   script: |
@@ -574,7 +574,7 @@ release:darwin:aarch64:
     # otherwise we seem to get intel binaries
     - export HOMEBREW_CHANGE_ARCH_TO_ARM=1
     # update and install packages
-    - /bin/bash ./.gitlab/script/brew.sh llvm autoconf automake coreutils
+    - /bin/bash ./.gitlab/script/brew.sh llvm autoconf automake
   script: |
     export PATH="$CI_PROJECT_DIR/.brew/opt/llvm/bin:$CI_PROJECT_DIR/.brew/bin:$CI_PROJECT_DIR/.brew/sbin:$PATH"
     export CC=$CI_PROJECT_DIR/.brew/opt/llvm/bin/clang

.gitlab/script/ghcup_bootstrap.sh

@@ -6,10 +6,20 @@ set -eux
 
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
 
+ecabal() {
+	cabal "$@"
+}
+
+eghcup() {
+	ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
+}
+
 git describe --always
 
 ### build
 
+ecabal update
+
 export BOOTSTRAP_HASKELL_NONINTERACTIVE=yes
 export BOOTSTRAP_HASKELL_GHC_VERSION=$GHC_VERSION
 export BOOTSTRAP_HASKELL_CABAL_VERSION=$CABAL_VERSION

.gitlab/script/ghcup_version.sh

@@ -97,23 +97,17 @@ rm -rf "${GHCUP_DIR}"
 eghcup --numeric-version
 
 eghcup install ghc ${GHC_VERSION}
-eghcup unset ghc ${GHC_VERSION}
 ls -lah "$(eghcup whereis -d ghc ${GHC_VERSION})"
 [ "`$(eghcup whereis ghc ${GHC_VERSION}) --numeric-version`" = "${GHC_VERSION}" ]
 [ "`eghcup run --ghc ${GHC_VERSION} -- ghc --numeric-version`" = "${GHC_VERSION}" ]
-[ "`ghcup run --ghc ${GHC_VERSION} -- ghc -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" = "`$(ghcup whereis ghc ${GHC_VERSION}) -e 'Control.Monad.join (Control.Monad.fmap System.IO.putStr System.Environment.getExecutablePath)'`" ]
 eghcup set ghc ${GHC_VERSION}
 eghcup install cabal ${CABAL_VERSION}
 [ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
 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_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
 eghcup set cabal ${CABAL_VERSION}
-
 [ "`$(eghcup whereis cabal ${CABAL_VERSION}) --numeric-version`" = "${CABAL_VERSION}" ]
+[ "`eghcup run --cabal ${CABAL_VERSION} -- cabal --numeric-version`" = "${CABAL_VERSION}" ]
 
 if [ "${OS}" != "FREEBSD" ] ; then
 	if [ "${ARCH}" = "64" ] ; then
@@ -222,7 +216,7 @@ 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 install cabal -u https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-ubuntu-16.04.tar.xz 3.4.0.0-rc4
 		eghcup rm cabal 3.4.0.0-rc4
 	fi
 fi
@@ -295,20 +289,7 @@ fi
 eghcup upgrade
 eghcup upgrade -f
 
-# 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 ]
-
-

CHANGELOG.md

@@ -1,44 +1,5 @@
 # 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)
-
-## 0.1.17.9 -- 2022-05-12
-
-* broken sdist (hackage-only release)
-
 ## 0.1.17.8 -- 2022-05-11
 
 * Fix a serious (but hard to trigger) bug when combining `--isolate <DIR>` with `--force`, please make sure to upgrade or avoid `--force`

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 the main installer for the general purpose language [Haskell](https://www.haskell.org/).
+GHCup is an installer for the general purpose language [Haskell](https://www.haskell.org/).
 
 Visit the [documentation](https://www.haskell.org/ghcup/) for installation instructions.
 

app/ghcup/BrickMain.hs

@@ -13,12 +13,9 @@ 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           GHCup.Utils.Logger
+import           GHCup.Utils.Prelude ( decUTF8Safe )
+import           GHCup.Utils.File
 
 import           Brick
 import           Brick.Widgets.Border
@@ -54,8 +51,6 @@ 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)
@@ -102,7 +97,7 @@ keyHandlers KeyBindings {..} =
   [ (bQuit, const "Quit"     , halt)
   , (bInstall, const "Install"  , withIOAction install')
   , (bUninstall, const "Uninstall", withIOAction del')
-  , (bSet, const "Set"      , withIOAction set')
+  , (bSet, const "Set"      , withIOAction ((liftIO .) . set'))
   , (bChangelog, const "ChangeLog", withIOAction changelog')
   , ( bShowAllVersions
     , \BrickSettings {..} ->
@@ -434,7 +429,6 @@ install' _ (_, ListResult {..}) = do
               , BuildFailed
               , TagNotFound
               , DigestError
-              , ContentLengthError
               , GPGError
               , DownloadFailed
               , DirNotEmpty
@@ -442,9 +436,8 @@ install' _ (_, ListResult {..}) = do
               , TarDirDoesNotExist
               , FileAlreadyExistsError
               , ProcessError
-              , ToolShadowed
+              , GHCupShadowed
               , UninstallFailed
-              , MergeFileTreeError
               ]
 
   run (do
@@ -454,7 +447,7 @@ install' _ (_, ListResult {..}) = do
       case lTool of
         GHC   -> do
           let vi = getVersionInfo lVer GHC dls
-          liftE $ installGHCBin lVer GHCupInternal False [] $> (vi, dirs, ce)
+          liftE $ installGHCBin lVer GHCupInternal False $> (vi, dirs, ce)
         Cabal -> do
           let vi = getVersionInfo lVer Cabal dls
           liftE $ installCabalBin lVer GHCupInternal False $> (vi, dirs, ce)
@@ -487,16 +480,13 @@ install' _ (_, ListResult {..}) = do
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
           VLeft (V NoUpdate) -> pure $ Right ()
-          VLeft e -> pure $ Left $ prettyHFError e <> "\n"
+          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'
+set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
+set' _ (_, ListResult {..}) = do
+  settings <- readIORef settings'
 
   let run =
         flip runReaderT settings
@@ -512,28 +502,7 @@ set' bs input@(_, ListResult {..}) = do
     )
     >>= \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 (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)
-
+          VLeft  e -> pure $ Left (prettyShow e)
 
 
 del' :: (MonadReader AppState m, MonadIO m, MonadFail m, MonadMask m, MonadUnliftIO m)
@@ -556,11 +525,10 @@ del' _ (_, ListResult {..}) = do
     )
     >>= \case
           VRight vi -> do
-            logGHCPostRm (mkTVer lVer)
             forM_ (_viPostRemove =<< vi) $ \msg ->
               logInfo msg
             pure $ Right ()
-          VLeft  e -> pure $ Left (prettyHFError e)
+          VLeft  e -> pure $ Left (prettyShow e)
 
 
 changelog' :: (MonadReader AppState m, MonadIO m)
@@ -580,7 +548,7 @@ changelog' _ (_, ListResult {..}) = do
             Windows -> "start"
       exec cmd [T.unpack $ decUTF8Safe $ serializeURIRef' uri] Nothing Nothing >>= \case
         Right _ -> pure $ Right ()
-        Left  e -> pure $ Left $ prettyHFError e
+        Left  e -> pure $ Left $ prettyShow e
 
 
 settings' :: IORef AppState
@@ -633,12 +601,12 @@ getGHCupInfo = do
 
   r <-
     flip runReaderT settings
-    . runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
+    . runE @'[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
     $ liftE getDownloadsF
 
   case r of
     VRight a -> pure $ Right a
-    VLeft  e -> pure $ Left (prettyHFError e)
+    VLeft  e -> pure $ Left (prettyShow e)
 
 
 getAppData :: Maybe GHCupInfo

app/ghcup/GHCup/OptParse.hs

@@ -8,7 +8,6 @@
 module GHCup.OptParse (
     module GHCup.OptParse.Common
   , module GHCup.OptParse.Install
-  , module GHCup.OptParse.Test
   , module GHCup.OptParse.Set
   , module GHCup.OptParse.UnSet
   , module GHCup.OptParse.Rm
@@ -32,7 +31,6 @@ module GHCup.OptParse (
 
 import           GHCup.OptParse.Common
 import           GHCup.OptParse.Install
-import           GHCup.OptParse.Test
 import           GHCup.OptParse.Set
 import           GHCup.OptParse.UnSet
 import           GHCup.OptParse.Rm
@@ -69,14 +67,13 @@ import           URI.ByteString
 import qualified Data.ByteString.UTF8          as UTF8
 
 
+
 data Options = Options
   {
   -- global options
     optVerbose     :: Maybe Bool
   , optCache       :: Maybe Bool
   , optMetaCache   :: Maybe Integer
-  , optMetaMode    :: Maybe MetaMode
-  , optPlatform    :: Maybe PlatformRequest
   , optUrlSource   :: Maybe URI
   , optNoVerify    :: Maybe Bool
   , optKeepDirs    :: Maybe KeepDirs
@@ -89,7 +86,6 @@ data Options = Options
 
 data Command
   = Install (Either InstallCommand InstallOptions)
-  | Test TestCommand
   | InstallCabalLegacy InstallOptions
   | Set (Either SetCommand SetOptions)
   | UnSet UnsetCommand
@@ -111,7 +107,6 @@ data Command
   | Prefetch PrefetchCommand
   | GC GCOptions
   | Run RunOptions
-  | PrintAppErrors
 
 
 
@@ -120,18 +115,7 @@ 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" <> 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 auto (long "metadata-caching" <> help "How long the yaml metadata caching interval is (in seconds), 0 to disable" <> internal))
     <*> optional
           (option
             (eitherReader parseUri)
@@ -208,14 +192,6 @@ com =
                 <> footerDoc (Just $ text installToolFooter)
                 )
           )
-      <> command
-           "test"
-           (info
-             (Test <$> testParser <**> helper)
-             (  progDesc "Run tests for a tool (if any) [EXPERIMENTAL!]"
-             <> footerDoc (Just $ text testFooter)
-             )
-           )
       <> command
            "set"
            (info
@@ -353,10 +329,3 @@ com =
            <> commandGroup "Nuclear Commands:"
            <> hidden
           )
-     <|> subparser
-          (command
-              "print-app-errors"
-               (info (pure PrintAppErrors <**> helper)
-                     (progDesc ""))
-           <> internal
-          )

app/ghcup/GHCup/OptParse/ChangeLog.hs

@@ -12,12 +12,9 @@ module GHCup.OptParse.ChangeLog where
 
 
 import           GHCup.Types
-import           GHCup.Errors
+import           GHCup.Utils.Logger
 import           GHCup.OptParse.Common
-import           GHCup.Prelude
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
-import           GHCup.Prelude.Process (exec)
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -37,6 +34,8 @@ import GHCup.Types.Optics
 import GHCup.Utils
 import Data.Versions
 import URI.ByteString (serializeURIRef')
+import GHCup.Utils.Prelude
+import GHCup.Utils.File (exec)
 import Data.Char (toLower)
 
 
@@ -59,7 +58,7 @@ data ChangeLogOptions = ChangeLogOptions
     --[ Parsers ]--
     ---------------
 
-
+          
 changelogP :: Parser ChangeLogOptions
 changelogP =
   (\x y -> ChangeLogOptions x y)
@@ -72,16 +71,15 @@ changelogP =
                 "cabal" -> Right Cabal
                 "ghcup" -> Right GHCup
                 "stack" -> Right Stack
-                "hls"   -> Right HLS
                 e       -> Left e
               )
             )
-            (short 't' <> long "tool" <> metavar "<ghc|cabal|hls|ghcup>" <> help
+            (short 't' <> long "tool" <> metavar "<ghc|cabal|ghcup>" <> help
               "Open changelog for given tool (default: ghc)"
               <> completer toolCompleter
             )
           )
-    <*> optional (toolVersionTagArgument Nothing Nothing)
+    <*> optional (toolVersionArgument Nothing Nothing)
 
 
 
@@ -118,8 +116,7 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
       ver' = maybe
         (Right Latest)
         (\case
-          GHCVersion tv  -> Left (_tvVersion tv)
-          ToolVersion tv -> Left tv
+          ToolVersion tv -> Left (_tvVersion tv) -- FIXME: ugly sharing of ToolVersion
           ToolTag     t  -> Right t
         )
         clToolVer
@@ -149,6 +146,6 @@ changelog ChangeLogOptions{..} runAppState runLogger = do
                  Nothing
               >>= \case
                     Right _ -> pure ExitSuccess
-                    Left  e -> logError (T.pack $ prettyHFError e)
+                    Left  e -> logError (T.pack $ prettyShow e)
                       >> pure (ExitFailure 13)
         else liftIO $ putStrLn uri' >> pure ExitSuccess

app/ghcup/GHCup/OptParse/Common.hs

@@ -16,16 +16,15 @@ import           GHCup.Platform
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
-import           GHCup.Prelude
-import           GHCup.Prelude.Process
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.MegaParsec
+import           GHCup.Utils.File
+import           GHCup.Utils.Logger
+import           GHCup.Utils.MegaParsec
+import           GHCup.Utils.Prelude
 
 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
@@ -65,31 +64,26 @@ 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
 
 
     -------------
     --[ Types ]--
     -------------
 
-data ToolVersion = GHCVersion GHCTargetVersion
-                 | ToolVersion Version
+data ToolVersion = ToolVersion GHCTargetVersion -- target is ignored for cabal
                  | ToolTag Tag
 
 -- a superset of ToolVersion
-data SetToolVersion = SetGHCVersion GHCTargetVersion
-                    | SetToolVersion Version
+data SetToolVersion = SetToolVersion GHCTargetVersion
                     | SetToolTag Tag
                     | SetRecommended
                     | SetNext
 
 prettyToolVer :: ToolVersion -> String
-prettyToolVer (GHCVersion v') = T.unpack $ tVerToText v'
-prettyToolVer (ToolVersion v') = T.unpack $ prettyVer v'
+prettyToolVer (ToolVersion v') = T.unpack $ tVerToText v'
 prettyToolVer (ToolTag t) = show t
 
 toSetToolVer :: Maybe ToolVersion -> SetToolVersion
-toSetToolVer (Just (GHCVersion v')) = SetGHCVersion v'
 toSetToolVer (Just (ToolVersion v')) = SetToolVersion v'
 toSetToolVer (Just (ToolTag t')) = SetToolTag t'
 toSetToolVer Nothing = SetRecommended
@@ -102,9 +96,10 @@ toSetToolVer Nothing = SetRecommended
     --------------
 
 
-toolVersionTagArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
-toolVersionTagArgument criteria tool =
-  argument (eitherReader (parser tool))
+-- | same as toolVersionParser, except as an argument.
+toolVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser ToolVersion
+toolVersionArgument criteria tool =
+  argument (eitherReader toolVersionEither)
     (metavar (mv tool)
     <> completer (tagCompleter (fromMaybe GHC tool) [])
     <> foldMap (completer . versionCompleter criteria) tool)
@@ -113,19 +108,20 @@ toolVersionTagArgument criteria tool =
   mv (Just HLS) = "HLS_VERSION|TAG"
   mv _          = "VERSION|TAG"
 
-  parser (Just GHC) = ghcVersionTagEither
-  parser Nothing    = ghcVersionTagEither
-  parser _          = toolVersionTagEither
 
+versionParser :: Parser GHCTargetVersion
+versionParser = option
+  (eitherReader tVersionEither)
+  (short 'v' <> long "version" <> metavar "VERSION" <> help "The target version"
+  )
 
 versionParser' :: Maybe ListCriteria -> Maybe Tool -> Parser Version
 versionParser' criteria tool = argument
   (eitherReader (first show . version . T.pack))
   (metavar "VERSION"  <> foldMap (completer . versionCompleter criteria) tool)
 
-ghcVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
-ghcVersionArgument criteria tool = argument (eitherReader ghcVersionEither)
-                                            (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
+versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
+versionArgument criteria tool = argument (eitherReader tVersionEither) (metavar "VERSION" <> foldMap (completer . versionCompleter criteria) tool)
 
 
 -- https://github.com/pcapriotti/optparse-applicative/issues/148
@@ -230,19 +226,13 @@ absolutePathParser f = case isValid f && isAbsolute f of
               False -> Left "Please enter a valid absolute filepath."
 
 isolateParser :: FilePath -> Either String FilePath
-isolateParser f = case isValid f && isAbsolute f of
+isolateParser f = case isValid f of
               True -> Right $ normalise f
               False -> Left "Please enter a valid filepath for isolate dir."
 
--- this accepts cross prefix
-ghcVersionTagEither :: String -> Either String ToolVersion
-ghcVersionTagEither s' =
-  second ToolTag (tagEither s') <|> second GHCVersion (ghcVersionEither s')
-
--- this ignores cross prefix
-toolVersionTagEither :: String -> Either String ToolVersion
-toolVersionTagEither s' =
-  second ToolTag (tagEither s') <|> second ToolVersion (toolVersionEither s')
+toolVersionEither :: String -> Either String ToolVersion
+toolVersionEither s' =
+  second ToolTag (tagEither s') <|> second ToolVersion (tVersionEither s')
 
 tagEither :: String -> Either String Tag
 tagEither s' = case fmap toLower s' of
@@ -254,14 +244,10 @@ tagEither s' = case fmap toLower s' of
   other         -> Left $ "Unknown tag " <> other
 
 
-ghcVersionEither :: String -> Either String GHCTargetVersion
-ghcVersionEither =
+tVersionEither :: String -> Either String GHCTargetVersion
+tVersionEither =
   first (const "Not a valid version") . MP.parse ghcTargetVerP "" . T.pack
 
-toolVersionEither :: String -> Either String Version
-toolVersionEither =
-  first (const "Not a valid version") . MP.parse version' "" . T.pack
-
 
 toolParser :: String -> Either String Tool
 toolParser s' | t == T.pack "ghc"   = Right GHC
@@ -454,11 +440,9 @@ 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 = versionCompleter' criteria tool (const True)
 
-versionCompleter' :: Maybe ListCriteria -> Tool -> (Version -> Bool) -> Completer
-versionCompleter' criteria tool filter' = listIOCompleter $ do
+versionCompleter :: Maybe ListCriteria -> Tool -> Completer
+versionCompleter criteria tool = listIOCompleter $ do
   dirs' <- liftIO getAllDirs
   let loggerConfig = LoggerConfig
         { lcPrintDebug   = False
@@ -487,7 +471,7 @@ versionCompleter' criteria tool filter' = listIOCompleter $ do
           runEnv = flip runReaderT appState
 
       installedVersions <- runEnv $ listVersions (Just tool) criteria
-      return $ fmap (T.unpack . prettyVer) . filter filter' . fmap lVer $ installedVersions
+      return $ T.unpack . prettyVer . lVer <$> installedVersions
 
 
 toolDlCompleter :: Tool -> Completer
@@ -679,7 +663,7 @@ fromVersion' SetRecommended tool = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   bimap mkTVer Just <$> getRecommended dls tool
     ?? TagNotFound Recommended tool
-fromVersion' (SetGHCVersion v) tool = do
+fromVersion' (SetToolVersion v) tool = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   let vi = getVersionInfo (_tvVersion v) tool dls
   case pvp $ prettyVer (_tvVersion v) of -- need to be strict here
@@ -691,18 +675,6 @@ fromVersion' (SetGHCVersion v) tool = do
           when (v' /= _tvVersion v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
           pure (GHCTargetVersion (_tvTarget v) v', Just vi')
         Nothing -> pure (v, vi)
-fromVersion' (SetToolVersion v) tool = do
-  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-  let vi = getVersionInfo v tool dls
-  case pvp $ prettyVer v of -- need to be strict here
-    Left _ -> pure (mkTVer v, vi)
-    Right pvpIn ->
-      lift (getLatestToolFor tool pvpIn dls) >>= \case
-        Just (pvp_, vi') -> do
-          v' <- lift $ pvpToVersion pvp_ ""
-          when (v' /= v) $ lift $ logWarn ("Assuming you meant version " <> prettyVer v')
-          pure (GHCTargetVersion mempty v', Just vi')
-        Nothing -> pure (mkTVer v, vi)
 fromVersion' (SetToolTag Latest) tool = do
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
   bimap mkTVer Just <$> getLatest dls tool ?? TagNotFound Latest tool
@@ -791,12 +763,3 @@ 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,15 +12,14 @@ module GHCup.OptParse.Compile where
 
 
 import           GHCup
-import qualified GHCup.GHC as GHC
-import qualified GHCup.HLS as HLS
 import           GHCup.Errors
+import           GHCup.Utils.File
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
 import           GHCup.OptParse.Common
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -32,18 +31,18 @@ import           Control.Monad.Trans.Resource
 import           Data.Bifunctor
 import           Data.Functor
 import           Data.Maybe
-import           Data.Versions                  ( Version, prettyVer, version, pvp )
-import qualified Data.Versions as V
+import           Data.Versions                  ( Version, prettyVer, version )
 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, displayException)
+import Control.Exception.Safe (MonadMask)
 import System.FilePath (isPathSeparator)
 import Text.Read (readEither)
 
@@ -66,7 +65,7 @@ data CompileCommand = CompileGHC GHCCompileOptions
 
 
 data GHCCompileOptions = GHCCompileOptions
-  { targetGhc    :: GHC.GHCVer Version
+  { targetGhc    :: Either Version GitBranch
   , bootstrapGhc :: Either Version FilePath
   , jobs         :: Maybe Int
   , buildConfig  :: Maybe FilePath
@@ -80,13 +79,11 @@ data GHCCompileOptions = GHCCompileOptions
   , isolateDir   :: Maybe FilePath
   }
 
-
 data HLSCompileOptions = HLSCompileOptions
-  { targetHLS    :: HLS.HLSVer
+  { targetHLS    :: Either Version GitBranch
   , jobs         :: Maybe Int
   , setCompile   :: Bool
-  , updateCabal  :: Bool
-  , ovewrwiteVer :: Either Bool Version
+  , ovewrwiteVer :: Maybe Version
   , isolateDir   :: Maybe FilePath
   , cabalProject :: Maybe (Either FilePath URI)
   , cabalProjectLocal :: Maybe URI
@@ -149,22 +146,20 @@ Examples:
 
   compileHLSFooter = [s|Discussion:
   Compiles and installs the specified HLS version.
-  The --ghc arguments are necessary to specify which GHC version to build for/against.
+  The last argument is a list of GHC versions to compile for.
   These need to be available in PATH prior to compilation.
 
 Examples:
-  # 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|]
+  # compile 1.4.0 for ghc 8.10.5 and 8.10.7
+  ghcup compile hls -v 1.4.0 -j 12 --ghc 8.10.5 --ghc 8.10.7
+  # compile from master for ghc 8.10.7, linking everything dynamically
+  ghcup compile hls -g master -j 12 --ghc 8.10.7 -- --ghc-options='-dynamic'|]
 
 
 ghcCompileOpts :: Parser GHCCompileOptions
 ghcCompileOpts =
   GHCCompileOptions
-    <$> ((GHC.SourceDist <$> option
+    <$> ((Left <$> option
           (eitherReader
             (first (const "Not a valid version") . version . T.pack)
           )
@@ -173,7 +168,7 @@ ghcCompileOpts =
             <> (completer $ versionCompleter Nothing GHC)
           )
           ) <|>
-          (GHC.GitDist <$> (GitBranch <$> option
+          (Right <$> (GitBranch <$> option
           str
           (short 'g' <> long "git-ref" <> metavar "GIT_REFERENCE" <> help
             "The git commit/branch/ref to build from"
@@ -182,18 +177,7 @@ 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 ->
@@ -249,7 +233,7 @@ ghcCompileOpts =
               "Build cross-compiler for this platform"
             )
           )
-    <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to compile configure, prefix with '-- ' (longopts)"))
+    <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to configure, prefix with '-- ' (longopts)"))
     <*> fmap (fromMaybe False) (invertableSwitch "set" Nothing False (help "Set as active version after install"))
     <*> optional
           (option
@@ -285,46 +269,24 @@ ghcCompileOpts =
 hlsCompileOpts :: Parser HLSCompileOptions
 hlsCompileOpts =
   HLSCompileOptions
-    <$> ((HLS.HackageDist <$> option
+    <$> ((Left <$> option
           (eitherReader
-            ((>>= first displayException . V.version . V.prettyPVP) . first (const "Not a valid PVP version") . pvp . T.pack)
+            (first (const "Not a valid version") . version . T.pack)
           )
           (short 'v' <> long "version" <> metavar "VERSION" <> help
-            "The version to compile (pulled from hackage)"
-            <> (completer $ versionCompleter' Nothing HLS (either (const False) (const True) . V.pvp . V.prettyVer))
+            "The tool version to compile"
+            <> (completer $ versionCompleter Nothing HLS)
           )
-          )
-          <|>
-          (HLS.GitDist <$> (GitBranch <$> option
+          ) <|>
+          (Right <$> (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)"
+            "The git commit/branch/ref to build from"
           ) <*>
           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))
@@ -334,10 +296,8 @@ 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
+    <*> optional
+          (option
             (eitherReader
               (first (const "Not a valid version") . version . T.pack)
             )
@@ -346,14 +306,6 @@ hlsCompileOpts =
             <> (completer $ versionCompleter Nothing HLS)
             )
           )
-          <|>
-          (Left <$> (switch
-                      (long "git-describe-version"
-                         <> help "Use the output of 'git describe' (if building from git) as the VERSION component of the installed binary."
-                      )
-                    )
-          )
-          )
     <*> optional
           (option
             (eitherReader isolateParser)
@@ -400,7 +352,7 @@ hlsCompileOpts =
           )
         )
     <*> some (
-          option (eitherReader ghcVersionTagEither)
+          option (eitherReader toolVersionEither)
             (  long "ghc" <> metavar "GHC_VERSION|TAG" <> help "For which GHC version to compile for (can be specified multiple times)"
             <> completer (tagCompleter GHC [])
             <> completer (versionCompleter Nothing GHC))
@@ -419,7 +371,6 @@ hlsCompileOpts =
 type GHCEffects = '[ AlreadyInstalled
                   , BuildFailed
                   , DigestError
-                  , ContentLengthError
                   , GPGError
                   , DownloadFailed
                   , GHCupSetError
@@ -438,12 +389,10 @@ type GHCEffects = '[ AlreadyInstalled
                   , CopyError
                   , BuildFailed
                   , UninstallFailed
-                  , MergeFileTreeError
                   ]
 type HLSEffects = '[ AlreadyInstalled
                   , BuildFailed
                   , DigestError
-                  , ContentLengthError
                   , GPGError
                   , DownloadFailed
                   , GHCupSetError
@@ -459,7 +408,6 @@ type HLSEffects = '[ AlreadyInstalled
                   , DirNotEmpty
                   , ArchiveResult
                   , UninstallFailed
-                  , MergeFileTreeError
                   ]
 
 
@@ -508,7 +456,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileHLS HLSCompileOptions { .. }) -> do
       runCompileHLS runAppState (do
         case targetHLS of
-          HLS.SourceDist targetVer -> do
+          Left targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer HLS dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -516,7 +464,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
-          _ -> pure ()
+          Right _ -> pure ()
         ghcs <- liftE $ forM targetGHCs (\ghc -> fmap (_tvVersion . fst) . fromVersion (Just ghc) $ GHC)
         targetVer <- liftE $ compileHLS
                     targetHLS
@@ -526,7 +474,6 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
                     (maybe GHCupInternal IsolateDir isolateDir)
                     cabalProject
                     cabalProjectLocal
-                    updateCabal
                     patches
                     cabalArgs
         GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -545,14 +492,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 $ prettyHFError err
-                  _ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
+                  Never -> runLogger $ logError $ T.pack $ prettyShow err
+                  _ -> runLogger (logError $ T.pack (prettyShow 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 $ prettyHFError e
+                runLogger $ logError $ T.pack $ prettyShow e
                 pure $ ExitFailure 9
     (CompileGHC GHCCompileOptions { hadrian = True, crossTarget = Just _ }) -> do
       runLogger $ logError "Hadrian cross compile support is not yet implemented!"
@@ -560,7 +507,7 @@ compile compileCommand settings Dirs{..} runAppState runLogger = do
     (CompileGHC GHCCompileOptions {..}) ->
       runCompileGHC runAppState (do
         case targetGhc of
-          GHC.SourceDist targetVer -> do
+          Left targetVer -> do
             GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
             let vi = getVersionInfo targetVer GHC dls
             forM_ (_viPreCompile =<< vi) $ \msg -> do
@@ -568,12 +515,9 @@ 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
-          _ -> pure ()
+          Right _ -> pure ()
         targetVer <- liftE $ compileGHC
-                    ((\case
-                        GHC.SourceDist v -> GHC.SourceDist $ GHCTargetVersion crossTarget v
-                        GHC.GitDist g -> GHC.GitDist g
-                        GHC.RemoteDist r -> GHC.RemoteDist r) targetGhc)
+                    (first (GHCTargetVersion crossTarget) targetGhc)
                     ovewrwiteVer
                     bootstrapGhc
                     jobs
@@ -607,12 +551,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 $ prettyHFError err
-                  _ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
+                  Never -> runLogger $ logError $ T.pack $ prettyShow err
+                  _ -> runLogger (logError $ T.pack (prettyShow 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 $ prettyHFError e
+                runLogger $ logError $ T.pack $ prettyShow e
                 pure $ ExitFailure 9

app/ghcup/GHCup/OptParse/Config.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ExplicitForAll #-}
 
 module GHCup.OptParse.Config where
 
@@ -14,9 +15,9 @@ module GHCup.OptParse.Config where
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Utils
-import           GHCup.Prelude
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Prelude
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 import           GHCup.OptParse.Common
 
 #if !MIN_VERSION_base(4,13,0)
@@ -59,7 +60,7 @@ data ConfigCommand
     --[ Parsers ]--
     ---------------
 
-
+          
 configP :: Parser ConfigCommand
 configP = subparser
       (  command "init" initP
@@ -124,7 +125,6 @@ updateSettings :: UserSettings -> Settings -> Settings
 updateSettings UserSettings{..} Settings{..} =
    let cache'      = fromMaybe cache uCache
        metaCache'  = fromMaybe metaCache uMetaCache
-       metaMode'   = fromMaybe metaMode uMetaMode
        noVerify'   = fromMaybe noVerify uNoVerify
        keepDirs'   = fromMaybe keepDirs uKeepDirs
        downloader' = fromMaybe downloader uDownloader
@@ -132,8 +132,7 @@ updateSettings UserSettings{..} Settings{..} =
        urlSource'  = fromMaybe urlSource uUrlSource
        noNetwork'  = fromMaybe noNetwork uNoNetwork
        gpgSetting' = fromMaybe gpgSetting uGPGSetting
-       platformOverride' = uPlatformOverride <|> platformOverride
-   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
+   in Settings cache' metaCache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor
 
 
 
@@ -189,15 +188,9 @@ config configCommand settings keybindings runLogger = case configCommand of
       AddSource xs -> do
         doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
         pure ExitSuccess
-      GHCupURL -> do
+      _ -> 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

@@ -17,10 +17,9 @@ import           GHCup
 import           GHCup.Errors
 import           GHCup.Version
 import           GHCup.Types
+import           GHCup.Utils.Prelude
 import           GHCup.Utils.Dirs
-import           GHCup.Prelude
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.Process
+import           GHCup.Utils.Logger
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -37,6 +36,7 @@ import           Text.PrettyPrint.HughesPJClass ( prettyShow )
 
 import qualified Data.Text                     as T
 import Control.Exception.Safe (MonadMask)
+import GHCup.Utils.File
 import Language.Haskell.TH
 
 
@@ -115,5 +115,5 @@ dinfo runAppState runLogger = do
             liftIO $ putStrLn $ prettyDebugInfo di
             pure ExitSuccess
           VLeft e -> do
-            runLogger $ logError $ T.pack $ prettyHFError e
+            runLogger $ logError $ T.pack $ prettyShow e
             pure $ ExitFailure 8

app/ghcup/GHCup/OptParse/GC.hs

@@ -14,8 +14,8 @@ module GHCup.OptParse.GC where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -27,6 +27,7 @@ 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)
@@ -55,26 +56,26 @@ data GCOptions = GCOptions
     --[ Parsers ]--
     ---------------
 
-
+          
 gcP :: Parser GCOptions
 gcP =
   GCOptions
-  <$>
+  <$> 
     switch
       (short 'o' <> long "ghc-old" <> help "Remove GHC versions marked as 'old'")
-  <*>
+  <*> 
     switch
       (short 'p' <> long "profiling-libs" <> help "Remove profiling libs of GHC versions")
-  <*>
+  <*> 
     switch
       (short 's' <> long "share-dir" <> help "Remove GHC share directories (documentation)")
-  <*>
+  <*> 
     switch
       (short 'h' <> long "hls-no-ghc" <> help "Remove HLS versions that don't have a corresponding installed GHC version")
-  <*>
+  <*> 
     switch
       (short 'c' <> long "cache" <> help "GC the GHCup cache")
-  <*>
+  <*> 
     switch
       (short 't' <> long "tmpdirs" <> help "Remove tmpdir leftovers")
 
@@ -138,5 +139,5 @@ gc GCOptions{..} runAppState runLogger = runGC runAppState (do
             VRight _ -> do
                   pure ExitSuccess
             VLeft e -> do
-              runLogger $ logError $ T.pack $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 27

app/ghcup/GHCup/OptParse/Install.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE ViewPatterns      #-}
-{-# LANGUAGE TypeOperators     #-}
 
 module GHCup.OptParse.Install where
 
@@ -20,9 +19,8 @@ import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Utils.Dirs
-import           GHCup.Prelude
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 
 import           Codec.Archive
 #if !MIN_VERSION_base(4,13,0)
@@ -33,11 +31,13 @@ import           Control.Monad.Trans.Resource
 import           Data.Either
 import           Data.Functor
 import           Data.Maybe
+import           Data.Versions           hiding ( str )
 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
@@ -65,11 +65,11 @@ data InstallCommand = InstallGHC InstallOptions
 
 data InstallOptions = InstallOptions
   { instVer      :: Maybe ToolVersion
+  , instPlatform :: Maybe PlatformRequest
   , instBindist  :: Maybe URI
   , instSet      :: Bool
   , isolateDir   :: Maybe FilePath
   , forceInstall :: Bool
-  , addConfArgs  :: [T.Text]
   }
 
 
@@ -169,13 +169,23 @@ Examples:
   ghcup install ghc 8.10.2
 
   # install GHC head fedora bindist
-  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|]
+  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|]
 
 
 installOpts :: Maybe Tool -> Parser InstallOptions
 installOpts tool =
-  (\(u, v) b is f -> InstallOptions v u b is f)
-    <$> (   (   (,)
+  (\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"
+            )
+          )
+    <*> (   (   (,)
             <$> optional
                   (option
                     (eitherReader uriParser)
@@ -184,7 +194,7 @@ installOpts tool =
                       <> completer (toolDlCompleter (fromMaybe GHC tool))
                     )
                   )
-            <*> (Just <$> toolVersionTagArgument Nothing tool)
+            <*> (Just <$> toolVersionArgument Nothing tool)
             )
         <|> pure (Nothing, Nothing)
         )
@@ -202,7 +212,6 @@ installOpts tool =
           )
     <*> switch
           (short 'f' <> long "force" <> help "Force install (THIS IS UNSAFE, only use it in Dockerfiles or CI)")
-    <*> many (argument str (metavar "CONFIGURE_ARGS" <> help "Additional arguments to bindist configure, prefix with '-- ' (longopts)"))
  where
   setDefault = case tool of
     Nothing  -> False
@@ -242,7 +251,6 @@ type InstallEffects = '[ AlreadyInstalled
                        , BuildFailed
                        , TagNotFound
                        , DigestError
-                       , ContentLengthError
                        , GPGError
                        , DownloadFailed
                        , TarDirDoesNotExist
@@ -251,50 +259,120 @@ type InstallEffects = '[ AlreadyInstalled
                        , FileAlreadyExistsError
                        , ProcessError
                        , UninstallFailed
-                       , MergeFileTreeError
-                       , InstallSetError
+
+                       , (AlreadyInstalled, ())
+                       , (UnknownArchive, ())
+                       , (ArchiveResult, ())
+                       , (FileDoesNotExistError, ())
+                       , (CopyError, ())
+                       , (NotInstalled, ())
+                       , (UninstallFailed, ())
+                       , (DirNotEmpty, ())
+                       , (NoDownload, ())
+                       , (BuildFailed, ())
+                       , (TagNotFound, ())
+                       , (DigestError, ())
+                       , (GPGError, ())
+                       , (DownloadFailed, ())
+                       , (TarDirDoesNotExist, ())
+                       , (NextVerNotFound, ())
+                       , (NoToolVersionSet, ())
+                       , (FileAlreadyExistsError, ())
+                       , (ProcessError, ())
+
+                       , (AlreadyInstalled, NotInstalled)
+                       , (UnknownArchive, NotInstalled)
+                       , (ArchiveResult, NotInstalled)
+                       , (FileDoesNotExistError, NotInstalled)
+                       , (CopyError, NotInstalled)
+                       , (NotInstalled, NotInstalled)
+                       , (DirNotEmpty, NotInstalled)
+                       , (NoDownload, NotInstalled)
+                       , (NotInstalled, NotInstalled)
+                       , (UninstallFailed, NotInstalled)
+                       , (BuildFailed, NotInstalled)
+                       , (TagNotFound, NotInstalled)
+                       , (DigestError, NotInstalled)
+                       , (GPGError, NotInstalled)
+                       , (DownloadFailed, NotInstalled)
+                       , (TarDirDoesNotExist, NotInstalled)
+                       , (NextVerNotFound, NotInstalled)
+                       , (NoToolVersionSet, NotInstalled)
+                       , (FileAlreadyExistsError, NotInstalled)
+                       , (ProcessError, NotInstalled)
+
+                       , ((), NotInstalled)
                        ]
 
 
 runInstTool :: AppState
+            -> Maybe PlatformRequest
             -> Excepts InstallEffects (ResourceT (ReaderT AppState IO)) a
             -> IO (VEither InstallEffects a)
-runInstTool appstate' =
-  flip runReaderT appstate'
+runInstTool appstate' mInstPlatform =
+  flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
   . runResourceT
   . runE
     @InstallEffects
 
 
-type InstallGHCEffects = '[ AlreadyInstalled
-                          , ArchiveResult
-                          , BuildFailed
-                          , CopyError
-                          , DigestError
-                          , ContentLengthError
-                          , DirNotEmpty
-                          , DownloadFailed
-                          , FileAlreadyExistsError
-                          , FileDoesNotExistError
-                          , GPGError
-                          , MergeFileTreeError
+type InstallGHCEffects = '[ TagNotFound
                           , NextVerNotFound
-                          , NoDownload
                           , NoToolVersionSet
-                          , NotInstalled
-                          , ProcessError
-                          , TagNotFound
-                          , TarDirDoesNotExist
+                          , BuildFailed
+                          , DirNotEmpty
+                          , AlreadyInstalled
                           , UninstallFailed
-                          , UnknownArchive
-                          , InstallSetError
+
+                          , (AlreadyInstalled, NotInstalled)
+                          , (UnknownArchive, NotInstalled)
+                          , (ArchiveResult, NotInstalled)
+                          , (FileDoesNotExistError, NotInstalled)
+                          , (CopyError, NotInstalled)
+                          , (NotInstalled, NotInstalled)
+                          , (DirNotEmpty, NotInstalled)
+                          , (NoDownload, NotInstalled)
+                          , (UninstallFailed, NotInstalled)
+                          , (BuildFailed, NotInstalled)
+                          , (TagNotFound, NotInstalled)
+                          , (DigestError, NotInstalled)
+                          , (GPGError, NotInstalled)
+                          , (DownloadFailed, NotInstalled)
+                          , (TarDirDoesNotExist, NotInstalled)
+                          , (NextVerNotFound, NotInstalled)
+                          , (NoToolVersionSet, NotInstalled)
+                          , (FileAlreadyExistsError, NotInstalled)
+                          , (ProcessError, NotInstalled)
+
+                          , (AlreadyInstalled, ())
+                          , (UnknownArchive, ())
+                          , (ArchiveResult, ())
+                          , (FileDoesNotExistError, ())
+                          , (CopyError, ())
+                          , (NotInstalled, ())
+                          , (DirNotEmpty, ())
+                          , (NoDownload, ())
+                          , (UninstallFailed, ())
+                          , (BuildFailed, ())
+                          , (TagNotFound, ())
+                          , (DigestError, ())
+                          , (GPGError, ())
+                          , (DownloadFailed, ())
+                          , (TarDirDoesNotExist, ())
+                          , (NextVerNotFound, ())
+                          , (NoToolVersionSet, ())
+                          , (FileAlreadyExistsError, ())
+                          , (ProcessError, ())
+
+                          , ((), NotInstalled)
                           ]
 
 runInstGHC :: AppState
+           -> Maybe PlatformRequest
            -> Excepts InstallGHCEffects (ResourceT (ReaderT AppState IO)) a
            -> IO (VEither InstallGHCEffects a)
-runInstGHC appstate' =
-  flip runReaderT appstate'
+runInstGHC appstate' mInstPlatform =
+  flip runReaderT (maybe appstate' (\x -> appstate'{ pfreq = x } :: AppState) mInstPlatform)
   . runResourceT
   . runE
     @InstallGHCEffects
@@ -319,27 +397,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installGHC InstallOptions{..} = do
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
-       Nothing -> runInstGHC s' $ do
+       Nothing -> runInstGHC s' instPlatform $ do
          (v, vi) <- liftE $ fromVersion instVer GHC
-         liftE $ runBothE' (installGHCBin
+         void $ liftE $ sequenceE (installGHCBin
                      (_tvVersion v)
                      (maybe GHCupInternal IsolateDir isolateDir)
                      forceInstall
-                     addConfArgs
                    )
-                   $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
+                   $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
          pure vi
        Just uri -> do
-         runInstGHC s'{ settings = settings {noVerify = True}} $ do
+         runInstGHC s'{ settings = settings {noVerify = True}} instPlatform $ do
            (v, vi) <- liftE $ fromVersion instVer GHC
-           liftE $ runBothE' (installGHCBindist
-                       (DownloadInfo uri (Just $ RegexDir "ghc-.*") "" Nothing)
+           void $ liftE $ sequenceE (installGHCBindist
+                       (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
                        (_tvVersion v)
                        (maybe GHCupInternal IsolateDir isolateDir)
                        forceInstall
-                       addConfArgs
                      )
-                     $ when instSet $ when (isNothing isolateDir) $ liftE $ void $ setGHC v SetGHCOnly Nothing
+                     $ when instSet $ when (isNothing isolateDir) $ void $ setGHC v SetGHCOnly Nothing
            pure vi
       )
         >>= \case
@@ -349,40 +425,42 @@ install installCommand settings getAppState' runLogger = case installCommand of
                   runLogger $ logInfo msg
                 pure ExitSuccess
 
-              VLeft e@(V (AlreadyInstalled _ _)) -> do
-                runLogger $ logWarn $ T.pack $ prettyHFError e
+              VLeft (V (AlreadyInstalled _ v, ())) -> do
+                runLogger $ logWarn $
+                  "GHC ver " <> prettyVer v <> " already installed, remove it first to reinstall"
                 pure ExitSuccess
-              VLeft e@(V (AlreadyInstalled _ _)) -> do
-                runLogger $ logWarn $ T.pack $ prettyHFError e
+              VLeft (V (AlreadyInstalled _ v)) -> do
+                runLogger $ logWarn $
+                  "GHC ver " <> prettyVer v <> " already installed, remove it first to reinstall"
                 pure ExitSuccess
 
               VLeft (V (DirNotEmpty fp)) -> do
                 runLogger $ logError $
                   "Install directory " <> T.pack fp <> " is not empty."
                 pure $ ExitFailure 3
-              VLeft (V (DirNotEmpty fp)) -> do
+              VLeft (V (DirNotEmpty fp, ())) -> do
                 runLogger $ logError $
                   "Install directory " <> T.pack fp <> " is not empty."
                 pure $ ExitFailure 3
 
               VLeft err@(V (BuildFailed tmpdir _)) -> do
                 case keepDirs settings of
-                  Never -> runLogger (logError $ T.pack $ prettyHFError err)
-                  _ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
+                  Never -> runLogger (logError $ T.pack $ prettyShow err)
+                  _ -> runLogger (logError $ T.pack (prettyShow 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
+              VLeft err@(V (BuildFailed tmpdir _, ())) -> do
                 case keepDirs settings of
-                  Never -> runLogger (logError $ T.pack $ prettyHFError err)
-                  _ -> runLogger (logError $ T.pack (prettyHFError err) <> "\n" <>
+                  Never -> runLogger (logError $ T.pack $ prettyShow err)
+                  _ -> runLogger (logError $ T.pack (prettyShow 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 $ prettyHFError e
+                  logError $ T.pack $ prettyShow e
                   logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
                 pure $ ExitFailure 3
 
@@ -391,23 +469,23 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installCabal InstallOptions{..} = do
     s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
     (case instBindist of
-       Nothing -> runInstTool s' $ do
+       Nothing -> runInstTool s' instPlatform $ do
          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-         liftE $ runBothE' (installCabalBin
+         void $ liftE $ sequenceE (installCabalBin
                                     v
                                     (maybe GHCupInternal IsolateDir isolateDir)
                                     forceInstall
-                                  ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setCabal v
+                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
          pure vi
        Just uri -> do
-         runInstTool s'{ settings = settings { noVerify = True}} $ do
+         runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Cabal
-           liftE $ runBothE' (installCabalBindist
-                                      (DownloadInfo uri Nothing "" Nothing)
+           void $ liftE $ sequenceE (installCabalBindist
+                                      (DownloadInfo uri Nothing "")
                                       v
                                       (maybe GHCupInternal IsolateDir isolateDir)
                                       forceInstall
-                                    ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setCabal v
+                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setCabal v
            pure vi
       )
       >>= \case
@@ -416,23 +494,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
               forM_ (_viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
-            VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyHFError e
+            VLeft (V (AlreadyInstalled _ v)) -> do
+              runLogger $ logWarn $
+                "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
               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 $ prettyHFError e
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install cabal --force " <> prettyVer v <> "'"
               pure ExitSuccess
-            VLeft (V (FileAlreadyExistsError fp)) -> do
+            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 -> do
               runLogger $ do
-                logError $ T.pack $ prettyHFError e
+                logError $ T.pack $ prettyShow e
                 logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
               pure $ ExitFailure 4
 
@@ -440,24 +520,24 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installHLS InstallOptions{..} = do
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
-       Nothing -> runInstTool s' $ do
+       Nothing -> runInstTool s' instPlatform $ do
          (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
-         liftE $ runBothE' (installHLSBin
+         void $ liftE $ sequenceE (installHLSBin
                                     v
                                     (maybe GHCupInternal IsolateDir isolateDir)
                                     forceInstall
-                                  ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setHLS v SetHLSOnly Nothing
+                                  ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
          pure vi
        Just uri -> do
-         runInstTool s'{ settings = settings { noVerify = True}} $ do
+         runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
            (_tvVersion -> v, vi) <- liftE $ fromVersion instVer HLS
            -- TODO: support legacy
-           liftE $ runBothE' (installHLSBindist
-                                      (DownloadInfo uri (if isWindows then Nothing else Just (RegexDir "haskell-language-server-*")) "" Nothing)
+           void $ liftE $ sequenceE (installHLSBindist
+                                      (DownloadInfo uri (Just $ RegexDir "haskell-language-server-*") "")
                                       v
                                       (maybe GHCupInternal IsolateDir isolateDir)
                                       forceInstall
-                                    ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setHLS v SetHLSOnly Nothing
+                                    ) $ when instSet $ when (isNothing isolateDir) $ void $ setHLS v SetHLSOnly Nothing
            pure vi
       )
       >>= \case
@@ -466,23 +546,33 @@ install installCommand settings getAppState' runLogger = case installCommand of
               forM_ (_viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
-            VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyHFError e
+            VLeft (V (AlreadyInstalled _ v)) -> do
+              runLogger $ logWarn $
+                  "HLS ver "
+                <> prettyVer v
+                <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
+                <> prettyVer v
+                <> "'"
               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 $ prettyHFError e
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                  "HLS ver "
+                <> prettyVer v
+                <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install hls --force "
+                <> prettyVer v
+                <> "'"
               pure ExitSuccess
-            VLeft (V (FileAlreadyExistsError fp)) -> do
+            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 -> do
               runLogger $ do
-                logError $ T.pack $ prettyHFError e
+                logError $ T.pack $ prettyShow e
                 logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
               pure $ ExitFailure 4
 
@@ -490,23 +580,23 @@ install installCommand settings getAppState' runLogger = case installCommand of
   installStack InstallOptions{..} = do
      s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
      (case instBindist of
-        Nothing -> runInstTool s' $ do
+        Nothing -> runInstTool s' instPlatform $ do
           (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-          liftE $ runBothE' (installStackBin
+          void $ liftE $ sequenceE (installStackBin
                                      v
                                      (maybe GHCupInternal IsolateDir isolateDir)
                                      forceInstall
-                                   ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setStack v
+                                   ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
           pure vi
         Just uri -> do
-          runInstTool s'{ settings = settings { noVerify = True}} $ do
+          runInstTool s'{ settings = settings { noVerify = True}} instPlatform $ do
             (_tvVersion -> v, vi) <- liftE $ fromVersion instVer Stack
-            liftE $ runBothE' (installStackBindist
-                                       (DownloadInfo uri Nothing "" Nothing)
+            void $ liftE $ sequenceE (installStackBindist
+                                       (DownloadInfo uri Nothing "")
                                        v
                                        (maybe GHCupInternal IsolateDir isolateDir)
                                        forceInstall
-                                     ) $ when instSet $ when (isNothing isolateDir) $ liftE $ setStack v
+                                     ) $ when instSet $ when (isNothing isolateDir) $ void $ setStack v
             pure vi
       )
       >>= \case
@@ -515,22 +605,25 @@ install installCommand settings getAppState' runLogger = case installCommand of
               forM_ (_viPostInstall =<< vi) $ \msg ->
                 runLogger $ logInfo msg
               pure ExitSuccess
-            VLeft e@(V (AlreadyInstalled _ _)) -> do
-              runLogger $ logWarn $ T.pack $ prettyHFError e
+            VLeft (V (AlreadyInstalled _ v)) -> do
+              runLogger $ logWarn $
+                "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
               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 $ prettyHFError e
+            VLeft (V (AlreadyInstalled _ v, ())) -> do
+              runLogger $ logWarn $
+                "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup install stack --force " <> prettyVer v <> "'"
               pure ExitSuccess
-            VLeft (V (FileAlreadyExistsError fp)) -> do
+            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 -> do
               runLogger $ do
-                logError $ T.pack $ prettyHFError e
+                logError $ T.pack $ prettyShow e
                 logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
               pure $ ExitFailure 4
+

app/ghcup/GHCup/OptParse/List.hs

@@ -11,7 +11,7 @@ module GHCup.OptParse.List where
 
 
 import           GHCup
-import           GHCup.Prelude
+import           GHCup.Utils.Prelude
 import           GHCup.Types
 import           GHCup.OptParse.Common
 

app/ghcup/GHCup/OptParse/Nuke.hs

@@ -14,7 +14,7 @@ module GHCup.OptParse.Nuke where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Prelude.Logger
+import           GHCup.Utils.Logger
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -26,6 +26,7 @@ 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)
@@ -94,5 +95,5 @@ nuke appState runLogger = do
                       pure ExitSuccess
 
                 VLeft e -> do
-                  runLogger $ logError $ T.pack $ prettyHFError e
+                  runLogger $ logError $ T.pack $ prettyShow e
                   pure $ ExitFailure 15

app/ghcup/GHCup/OptParse/Prefetch.hs

@@ -14,10 +14,9 @@ module GHCup.OptParse.Prefetch where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Prelude.File
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
 import           GHCup.OptParse.Common
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -30,9 +29,11 @@ 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)
+import GHCup.Utils.Prelude
 import GHCup.Download (getDownloadsF)
 
 
@@ -73,44 +74,44 @@ data PrefetchGHCOptions = PrefetchGHCOptions {
     --[ Parsers ]--
     ---------------
 
-
+          
 prefetchP :: Parser PrefetchCommand
 prefetchP = subparser
   (  command
       "ghc"
-      (info
+      (info 
         (PrefetchGHC
           <$> (PrefetchGHCOptions
                 <$> ( switch (short 's' <> long "source" <> help "Download source tarball instead of bindist") <**> helper )
                 <*> optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*>  optional (toolVersionTagArgument Nothing (Just GHC)) )
+          <*>  optional (toolVersionArgument Nothing (Just GHC)) )
         ( progDesc "Download GHC assets for installation")
       )
       <>
      command
       "cabal"
-      (info
+      (info 
         (PrefetchCabal
           <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper ))
+          <*> ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper ))
         ( progDesc "Download cabal assets for installation")
       )
       <>
      command
       "hls"
-      (info
+      (info 
         (PrefetchHLS
           <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper ))
+          <*> ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper ))
         ( progDesc "Download HLS assets for installation")
       )
       <>
      command
       "stack"
-      (info
+      (info 
         (PrefetchStack
           <$> fmap PrefetchOptions (optional (option str (short 'd' <> long "directory" <> help "directory to download into (default: ~/.ghcup/cache/)" <> completer (bashCompleter "directory"))))
-          <*> ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper ))
+          <*> ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper ))
         ( progDesc "Download stack assets for installation")
       )
       <>
@@ -152,7 +153,6 @@ 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 $ prettyHFError e
+                  runLogger $ logError $ T.pack $ prettyShow e
                   pure $ ExitFailure 15

app/ghcup/GHCup/OptParse/Rm.hs

@@ -18,9 +18,9 @@ import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Utils
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
 import           GHCup.OptParse.Common
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -34,6 +34,7 @@ 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)
@@ -70,7 +71,7 @@ data RmOptions = RmOptions
     --[ Parsers ]--
     ---------------
 
-
+          
 rmParser :: Parser (Either RmCommand RmOptions)
 rmParser =
   (Left <$> subparser
@@ -102,7 +103,7 @@ rmParser =
 
 
 rmOpts :: Maybe Tool -> Parser RmOptions
-rmOpts tool = RmOptions <$> ghcVersionArgument (Just ListInstalled) tool
+rmOpts tool = RmOptions <$> versionArgument (Just ListInstalled) tool
 
 
 
@@ -174,11 +175,11 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              runLogger $ logGHCPostRm ghcVer
-              postRmLog vi
+              forM_ (_viPostRemove =<< vi) $ \msg ->
+                runLogger $ logInfo msg
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 7
 
   rmCabal' tv =
@@ -190,10 +191,11 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              postRmLog vi
+              forM_ (_viPostRemove =<< vi) $ \msg ->
+                runLogger $ logInfo msg
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 15
 
   rmHLS' tv =
@@ -205,10 +207,11 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              postRmLog vi
+              forM_ (_viPostRemove =<< vi) $ \msg ->
+                runLogger $ logInfo msg
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 15
 
   rmStack' tv =
@@ -220,12 +223,10 @@ rm rmCommand runAppState runLogger = case rmCommand of
       )
       >>= \case
             VRight vi -> do
-              postRmLog vi
+              forM_ (_viPostRemove =<< vi) $ \msg ->
+                runLogger $ logInfo msg
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 15
 
-  postRmLog vi =
-    forM_ (_viPostRemove =<< vi) $ \msg ->
-      runLogger $ logInfo msg

app/ghcup/GHCup/OptParse/Run.hs

@@ -5,24 +5,19 @@
 {-# LANGUAGE RankNTypes        #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE TypeFamilies      #-}
-{-# LANGUAGE ViewPatterns      #-}
 module GHCup.OptParse.Run where
 
 
 import           GHCup
 import           GHCup.Utils
+import           GHCup.Utils.Prelude
+import           GHCup.Utils.File
 import           GHCup.OptParse.Common
 import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.Optics
-import           GHCup.Prelude
-import           GHCup.Prelude.File
-#ifdef IS_WINDOWS
-import           GHCup.Prelude.Process
-import           GHCup.Prelude.Process.Windows ( execNoMinGW )
-#endif
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 
 import           Control.Exception.Safe         ( MonadMask, MonadCatch )
 #if !MIN_VERSION_base(4,13,0)
@@ -40,13 +35,13 @@ 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
 #ifndef IS_WINDOWS
 import qualified System.Posix.Process          as SPP
 #endif
-import Data.Versions ( prettyVer, Version )
 
 
 
@@ -60,7 +55,6 @@ import Data.Versions ( prettyVer, Version )
 data RunOptions = RunOptions
   { runAppendPATH :: Bool
   , runInstTool'  :: Bool
-  , runMinGWPath  :: Bool
   , runGHCVer     :: Maybe ToolVersion
   , runCabalVer   :: Maybe ToolVersion
   , runHLSVer     :: Maybe ToolVersion
@@ -85,11 +79,9 @@ runOpts =
           (short 'a' <> long "append" <> help "Append bin/ dir to PATH instead of prepending (this means that e.g. a system installation may take precedence)")
     <*> switch
           (short 'i' <> long "install" <> help "Install the tool, if missing")
-    <*> switch
-          (short 'm' <> long "mingw-path" <> help "On windows, add mingw64 PATHs to environment (does nothing on unix)")
     <*> optional
           (option
-            (eitherReader ghcVersionTagEither)
+            (eitherReader toolVersionEither)
             (metavar "GHC_VERSION" <> long "ghc" <> help "The ghc version"
             <> completer (tagCompleter GHC [])
             <> (completer $ versionCompleter Nothing GHC)
@@ -97,7 +89,7 @@ runOpts =
           )
     <*> optional
           (option
-            (eitherReader toolVersionTagEither)
+            (eitherReader toolVersionEither)
             (metavar "CABAL_VERSION" <> long "cabal" <> help "The cabal version"
             <> completer (tagCompleter Cabal [])
             <> (completer $ versionCompleter Nothing Cabal)
@@ -105,7 +97,7 @@ runOpts =
           )
     <*> optional
           (option
-            (eitherReader toolVersionTagEither)
+            (eitherReader toolVersionEither)
             (metavar "HLS_VERSION" <> long "hls" <> help "The HLS version"
             <> completer (tagCompleter HLS [])
             <> (completer $ versionCompleter Nothing HLS)
@@ -113,7 +105,7 @@ runOpts =
           )
     <*> optional
           (option
-            (eitherReader toolVersionTagEither)
+            (eitherReader toolVersionEither)
             (metavar "STACK_VERSION" <> long "stack" <> help "The stack version"
             <> completer (tagCompleter Stack [])
             <> (completer $ versionCompleter Nothing Stack)
@@ -176,7 +168,6 @@ type RunEffects = '[ AlreadyInstalled
                    , BuildFailed
                    , TagNotFound
                    , DigestError
-                   , ContentLengthError
                    , GPGError
                    , DownloadFailed
                    , TarDirDoesNotExist
@@ -185,7 +176,6 @@ type RunEffects = '[ AlreadyInstalled
                    , FileAlreadyExistsError
                    , ProcessError
                    , UninstallFailed
-                   , MergeFileTreeError
                    ]
 
 runLeanRUN :: (MonadUnliftIO m, MonadIO m)
@@ -219,7 +209,7 @@ runRUN appState action' = do
 
 
 
-run :: forall m .
+run :: forall m. 
        ( MonadFail m
        , MonadMask m
        , MonadCatch m
@@ -235,16 +225,12 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
    r <- if not runQuick
         then runRUN runAppState $ do
          toolchain <- liftE resolveToolchainFull
-
-         -- oh dear
-         r <- lift ask
-         tmp <- lift . lift . lift . flip runReaderT (fromAppState r) $ createTmpDir toolchain
-
+         tmp <- liftIO $ createTmpDir toolchain
          liftE $ installToolChainFull toolchain tmp
          pure tmp
         else runLeanRUN leanAppstate $ do
          toolchain <- resolveToolchain
-         tmp <- lift $ createTmpDir toolchain
+         tmp <- liftIO $ createTmpDir toolchain
          liftE $ installToolChain toolchain tmp
          pure tmp
    case r of
@@ -254,26 +240,35 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                liftIO $ putStr tmp
                pure ExitSuccess
              (cmd:args) -> do
-               newEnv <- liftIO $ addToPath tmp runAppendPATH
+               newEnv <- liftIO $ addToPath tmp
 #ifndef IS_WINDOWS
                void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
                pure ExitSuccess
 #else
-               r' <- if runMinGWPath
-                     then runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
-                     else runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ execNoMinGW cmd args Nothing (Just newEnv)
+               r' <- runLeanRUN leanAppstate $ liftE $ lEM @_ @'[ProcessError] $ exec cmd args Nothing (Just newEnv)
                case r' of
                  VRight _ -> pure ExitSuccess
                  VLeft e -> do
-                   runLogger $ logError $ T.pack $ prettyHFError e
+                   runLogger $ logError $ T.pack $ prettyShow e
                    pure $ ExitFailure 28
 #endif
          VLeft e -> do
-           runLogger $ logError $ T.pack $ prettyHFError e
+           runLogger $ logError $ T.pack $ prettyShow e
            pure $ ExitFailure 27
 
   where
 
+   createTmpDir :: Toolchain -> IO FilePath
+   createTmpDir toolchain =
+     case runBinDir of
+           Just bindir -> do
+             createDirRecursive' bindir
+             canonicalizePath bindir
+           Nothing -> do
+             d <- predictableTmpDir toolchain
+             createDirRecursive' d
+             canonicalizePath d
+
    -- TODO: doesn't work for cross
    resolveToolchainFull :: ( MonadFail m
                            , MonadThrow m
@@ -291,33 +286,29 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
            pure v
          cabalVer <- forM runCabalVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Cabal
-           pure (_tvVersion v)
+           pure v
          hlsVer <- forM runHLSVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) HLS
-           pure (_tvVersion v)
+           pure v
          stackVer <- forM runStackVer $ \ver -> do
            (v, _) <- liftE $ fromVersion (Just ver) Stack
-           pure (_tvVersion v)
+           pure v
          pure Toolchain{..}
 
    resolveToolchain = do
          ghcVer <- case runGHCVer of
-            Just (GHCVersion v) -> pure $ Just v
-            Just (ToolVersion v) -> pure $ Just (mkTVer v)
+            Just (ToolVersion v) -> pure $ Just v
             Nothing -> pure Nothing
             _ -> fail "Internal error"
          cabalVer <- case runCabalVer of
-            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
             Just (ToolVersion v) -> pure $ Just v
             Nothing -> pure Nothing
             _ -> fail "Internal error"
          hlsVer <- case runHLSVer of
-            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
             Just (ToolVersion v) -> pure $ Just v
             Nothing -> pure Nothing
             _ -> fail "Internal error"
          stackVer <- case runStackVer of
-            Just (GHCVersion v) -> pure $ Just (_tvVersion v)
             Just (ToolVersion v) -> pure $ Just v
             Nothing -> pure Nothing
             _ -> fail "Internal error"
@@ -343,53 +334,42 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                               , DownloadFailed
                               , DirNotEmpty
                               , DigestError
-                              , ContentLengthError
                               , BuildFailed
                               , ArchiveResult
                               , AlreadyInstalled
                               , FileAlreadyExistsError
                               , CopyError
                               , UninstallFailed
-                              , MergeFileTreeError
                               ] (ResourceT (ReaderT AppState m)) ()
    installToolChainFull Toolchain{..} tmp = do
-         case ghcVer of
-           Just v -> do
-             isInstalled <- lift $ checkIfToolInstalled' GHC v
-             unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
-               (_tvVersion v)
-               GHCupInternal
-               False
-               []
-             setGHC' v tmp
-           _ -> pure ()
-         case cabalVer of
-           Just v -> do
-             isInstalled <- lift $ checkIfToolInstalled' Cabal (mkTVer v)
-             unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
-               v
-               GHCupInternal
-               False
-             setCabal' v tmp
-           _ -> pure ()
-         case stackVer of
-           Just v -> do
-             isInstalled <- lift $ checkIfToolInstalled' Stack (mkTVer v)
-             unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
-               v
-               GHCupInternal
-               False
-             setStack' v tmp
-           _ -> pure ()
-         case hlsVer of
-           Just v -> do
-             isInstalled <- lift $ checkIfToolInstalled' HLS (mkTVer v)
-             unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
-               v
-               GHCupInternal
-               False
-             setHLS' v tmp
-           _ -> pure ()
+         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+           isInstalled <- maybe (pure False) (\(tool, v) -> lift $ checkIfToolInstalled' tool v) mt
+           case mt of
+             Just (GHC, v) -> do
+               unless isInstalled $ when (runInstTool' && isNothing (_tvTarget v)) $ void $ liftE $ installGHCBin
+                 (_tvVersion v)
+                 GHCupInternal
+                 False
+               setTool GHC v tmp
+             Just (Cabal, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installCabalBin
+                 (_tvVersion v)
+                 GHCupInternal
+                 False
+               setTool Cabal v tmp
+             Just (Stack, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installStackBin
+                 (_tvVersion v)
+                 GHCupInternal
+                 False
+               setTool Stack v tmp
+             Just (HLS, v) -> do
+               unless isInstalled $ when runInstTool' $ void $ liftE $ installHLSBin
+                 (_tvVersion v)
+                 GHCupInternal
+                 False
+               setTool HLS v tmp
+             _ -> pure ()
 
    installToolChain :: ( MonadFail m
                        , MonadThrow m
@@ -400,79 +380,67 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                     -> FilePath
                     -> Excepts '[NotInstalled] (ReaderT LeanAppState m) ()
    installToolChain Toolchain{..} tmp = do
-         case ghcVer of
-           Just v -> setGHC' v tmp
-           _ -> pure ()
-         case cabalVer of
-           Just v -> setCabal' v tmp
-           _ -> pure ()
-         case stackVer of
-           Just v -> setStack' v tmp
-           _ -> pure ()
-         case hlsVer of
-           Just v -> setHLS' v tmp
-           _ -> pure ()
+         forM_ [(GHC,) <$> ghcVer, (Cabal,) <$> cabalVer, (HLS,) <$> hlsVer, (Stack,) <$> stackVer] $ \mt -> do
+           case mt of
+             Just (GHC, v)   -> setTool GHC v tmp
+             Just (Cabal, v) -> setTool Cabal v tmp
+             Just (Stack, v) -> setTool Stack v tmp
+             Just (HLS, v)   -> setTool HLS v tmp
+             _ -> pure ()
 
-   setGHC' v tmp = do
+   setTool tool v tmp =
+      case tool of
+        GHC -> do
           void $ liftE $ setGHC v SetGHC_XYZ (Just tmp)
           void $ liftE $ setGHC v SetGHCOnly (Just tmp)
-   setCabal' v tmp = do
-          bin  <- liftE $ whereIsTool Cabal (mkTVer v)
+        Cabal -> do
+          bin  <- liftE $ whereIsTool Cabal v
           cbin <- liftIO $ canonicalizePath bin
           lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("cabal" <.> exeExt))
-   setStack' v tmp = do
-          bin  <- liftE $ whereIsTool Stack (mkTVer v)
+        Stack -> do
+          bin  <- liftE $ whereIsTool Stack v
           cbin <- liftIO $ canonicalizePath bin
           lift $ createLink (relativeSymlink tmp cbin) (tmp </> ("stack" <.> exeExt))
-   setHLS' v tmp = do
+        HLS -> do
           Dirs {..}  <- getDirs
-          legacy <- isLegacyHLS v
+          let v' = _tvVersion v
+          legacy <- isLegacyHLS v'
           if legacy
           then do
             -- TODO: factor this out
-            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v !? (NotInstalled HLS (mkTVer v))
+            hlsWrapper <- liftE @_ @'[NotInstalled] $ hlsWrapperBinary v' !? (NotInstalled HLS (mkTVer v'))
             cw <- liftIO $ canonicalizePath (binDir </> hlsWrapper)
             lift $ createLink (relativeSymlink tmp cw) (tmp </> takeFileName cw)
-            hlsBins <- hlsServerBinaries v Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
+            hlsBins <- hlsServerBinaries v' Nothing >>= liftIO . traverse (canonicalizePath . (binDir </>))
             forM_ hlsBins $ \bin ->
               lift $ createLink (relativeSymlink tmp bin) (tmp </> takeFileName bin)
-            liftE $ setHLS v SetHLSOnly (Just tmp)
+            liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
           else do
-            liftE $ setHLS v SetHLS_XYZ (Just tmp)
-            liftE $ setHLS v SetHLSOnly (Just tmp)
+            liftE $ setHLS (_tvVersion v) SetHLS_XYZ (Just tmp)
+            liftE $ setHLS (_tvVersion v) SetHLSOnly (Just tmp)
+        GHCup -> pure ()
+       
+   addToPath path = do
+    cEnv <- Map.fromList <$> getEnvironment
+    let paths          = ["PATH", "Path"]
+        curPaths       = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
+        newPath        = intercalate [searchPathSeparator] (if runAppendPATH then (curPaths ++ [path]) else (path : curPaths))
+        envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
+        pathVar        = if isWindows then "Path" else "PATH"
+        envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
+    liftIO $ setEnv pathVar newPath
+    return envWithNewPath
 
-   createTmpDir :: ( MonadUnliftIO m
-                   , MonadCatch m
-                   , MonadThrow m
-                   , MonadMask m
-                   , MonadIO m
-                   )
-                => Toolchain
-                -> ReaderT LeanAppState m FilePath
-   createTmpDir toolchain =
-     case runBinDir of
-           Just bindir -> do
-             liftIO $ createDirRecursive' bindir
-             liftIO $ canonicalizePath bindir
-           Nothing -> do
-             d <- predictableTmpDir toolchain
-             liftIO $ createDirRecursive' d
-             liftIO $ canonicalizePath d
-
-   predictableTmpDir :: Monad m
-                     => Toolchain
-                     -> ReaderT LeanAppState m FilePath
-   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) = do
-     Dirs { tmpDir } <- getDirs
-     pure (fromGHCupPath tmpDir </> "ghcup-none")
+   predictableTmpDir (Toolchain Nothing Nothing Nothing Nothing) =
+     liftIO (getTemporaryDirectory >>= \tmp -> pure (tmp </> "ghcup-none"))
    predictableTmpDir Toolchain{..} = do
-      Dirs { tmpDir } <- getDirs
-      pure $ fromGHCupPath tmpDir
+      tmp <- getTemporaryDirectory
+      pure $ tmp
         </> ("ghcup-" <> intercalate "_"
               (  maybe [] ( (:[]) . ("ghc-"   <>) . T.unpack . tVerToText) ghcVer
-              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . prettyVer) cabalVer
-              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . prettyVer) hlsVer
-              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . prettyVer) stackVer
+              <> maybe [] ( (:[]) . ("cabal-" <>) . T.unpack . tVerToText) cabalVer
+              <> maybe [] ( (:[]) . ("hls-"   <>) . T.unpack . tVerToText) hlsVer
+              <> maybe [] ( (:[]) . ("stack-" <>) . T.unpack . tVerToText) stackVer
               )
             )
 
@@ -486,7 +454,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
 
 data Toolchain = Toolchain
   { ghcVer     :: Maybe GHCTargetVersion
-  , cabalVer   :: Maybe Version
-  , hlsVer     :: Maybe Version
-  , stackVer   :: Maybe Version
-  } deriving Show
+  , cabalVer   :: Maybe GHCTargetVersion
+  , hlsVer     :: Maybe GHCTargetVersion
+  , stackVer   :: Maybe GHCTargetVersion
+  }

app/ghcup/GHCup/OptParse/Set.hs

@@ -17,8 +17,8 @@ import           GHCup.OptParse.Common
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -35,6 +35,7 @@ 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)
@@ -73,7 +74,7 @@ data SetOptions = SetOptions
     --[ Parsers ]--
     ---------------
 
-
+          
 setParser :: Parser (Either SetCommand SetOptions)
 setParser =
   (Left <$> subparser
@@ -81,7 +82,7 @@ setParser =
           "ghc"
           (   SetGHC
           <$> info
-                (setOpts GHC <**> helper)
+                (setOpts (Just GHC) <**> helper)
                 (  progDesc "Set GHC version"
                 <> footerDoc (Just $ text setGHCFooter)
                 )
@@ -90,7 +91,7 @@ setParser =
            "cabal"
            (   SetCabal
            <$> info
-                 (setOpts Cabal <**> helper)
+                 (setOpts (Just Cabal) <**> helper)
                  (  progDesc "Set Cabal version"
                  <> footerDoc (Just $ text setCabalFooter)
                  )
@@ -99,7 +100,7 @@ setParser =
            "hls"
            (   SetHLS
            <$> info
-                 (setOpts HLS <**> helper)
+                 (setOpts (Just HLS) <**> helper)
                  (  progDesc "Set haskell-language-server version"
                  <> footerDoc (Just $ text setHLSFooter)
                  )
@@ -108,14 +109,14 @@ setParser =
            "stack"
            (   SetStack
            <$> info
-                 (setOpts Stack <**> helper)
+                 (setOpts (Just Stack) <**> helper)
                  (  progDesc "Set stack version"
                  <> footerDoc (Just $ text setStackFooter)
                  )
            )
       )
     )
-    <|> (Right <$> setOpts GHC)
+    <|> (Right <$> setOpts Nothing)
  where
   setGHCFooter :: String
   setGHCFooter = [s|Discussion:
@@ -136,25 +137,22 @@ setParser =
     Sets the the current haskell-language-server version.|]
 
 
-setOpts :: Tool -> Parser SetOptions
+setOpts :: Maybe Tool -> Parser SetOptions
 setOpts tool = SetOptions <$>
     (fromMaybe SetRecommended <$>
       optional (setVersionArgument (Just ListInstalled) tool))
 
-setVersionArgument :: Maybe ListCriteria -> Tool -> Parser SetToolVersion
+setVersionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser SetToolVersion
 setVersionArgument criteria tool =
   argument (eitherReader setEither)
     (metavar "VERSION|TAG|next"
-    <> completer (tagCompleter tool ["next"])
-    <> (completer . versionCompleter criteria) tool)
+    <> completer (tagCompleter (fromMaybe GHC tool) ["next"])
+    <> foldMap (completer . versionCompleter criteria) tool)
  where
   setEither s' =
         parseSet s'
     <|> second SetToolTag (tagEither s')
-    <|> se s'
-  se s' = case tool of
-           GHC -> second SetGHCVersion (ghcVersionEither s')
-           _   -> second SetToolVersion (toolVersionEither s')
+    <|> second SetToolVersion (tVersionEither s')
   parseSet s' = case fmap toLower s' of
                   "next" -> Right SetNext
                   other  -> Left $ "Unknown tag/version " <> other
@@ -263,9 +261,9 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
   (Right sopts) -> do
     runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
     setGHC' sopts
-  (Left (SetGHC sopts))   -> setGHC'   sopts
+  (Left (SetGHC sopts)) -> setGHC' sopts
   (Left (SetCabal sopts)) -> setCabal' sopts
-  (Left (SetHLS sopts))   -> setHLS'   sopts
+  (Left (SetHLS sopts)) -> setHLS' sopts
   (Left (SetStack sopts)) -> setStack' sopts
 
  where
@@ -273,7 +271,7 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
           -> m ExitCode
   setGHC' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
+      (SetToolVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
       _ -> runSetGHC runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer GHC
           liftE $ setGHC v SetGHCOnly Nothing
@@ -285,7 +283,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 $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 5
 
 
@@ -293,40 +291,40 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
             -> m ExitCode
   setCabal' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
+      (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal (_tvVersion v) >> pure v)
       _ -> runSetCabal runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer Cabal
           liftE $ setCabal (_tvVersion v)
           pure v
         )
       >>= \case
-            VRight v -> do
+            VRight GHCTargetVersion{..} -> do
               runLogger
                 $ logInfo $
-                    "Cabal " <> prettyVer (_tvVersion v) <> " successfully set as default version"
+                    "Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 14
 
   setHLS' :: SetOptions
           -> m ExitCode
   setHLS' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
+      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing >> pure v)
       _ -> runSetHLS runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer HLS
           liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
           pure v
         )
       >>= \case
-            VRight v -> do
+            VRight GHCTargetVersion{..} -> do
               runLogger
                 $ logInfo $
-                    "HLS " <> prettyVer (_tvVersion v) <> " successfully set as default version"
+                    "HLS " <> prettyVer _tvVersion <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 14
 
 
@@ -334,18 +332,18 @@ set setCommand runAppState runLeanAppState runLogger = case setCommand of
             -> m ExitCode
   setStack' SetOptions{ sToolVer } =
     case sToolVer of
-      (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
+      (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack (_tvVersion v) >> pure v)
       _ -> runSetStack runAppState (do
             v <- liftE $ fst <$> fromVersion' sToolVer Stack
             liftE $ setStack (_tvVersion v)
             pure v
           )
       >>= \case
-            VRight v -> do
+            VRight GHCTargetVersion{..} -> do
               runLogger
                 $ logInfo $
-                    "Stack " <> prettyVer (_tvVersion v) <> " successfully set as default version"
+                    "Stack " <> prettyVer _tvVersion <> " successfully set as default version"
               pure ExitSuccess
             VLeft  e -> do
-              runLogger $ logError $ T.pack $ prettyHFError e
+              runLogger $ logError $ T.pack $ prettyShow e
               pure $ ExitFailure 14

app/ghcup/GHCup/OptParse/Test.hs

@@ -1,188 +0,0 @@
-{-# LANGUAGE CPP               #-}
-{-# LANGUAGE DataKinds         #-}
-{-# LANGUAGE TypeApplications  #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE TemplateHaskell   #-}
-{-# LANGUAGE QuasiQuotes       #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE ViewPatterns      #-}
-{-# LANGUAGE TypeOperators     #-}
-
-module GHCup.OptParse.Test where
-
-
-
-
-import           GHCup.OptParse.Common
-
-import           GHCup
-import           GHCup.Errors
-import           GHCup.Types
-import           GHCup.Utils.Dirs
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
-
-import           Codec.Archive
-#if !MIN_VERSION_base(4,13,0)
-import           Control.Monad.Fail             ( MonadFail )
-#endif
-import           Control.Monad.Reader
-import           Control.Monad.Trans.Resource
-import           Data.Functor
-import           Data.Maybe
-import           Haskus.Utils.Variant.Excepts
-import           Options.Applicative     hiding ( style )
-import           Options.Applicative.Help.Pretty ( text )
-import           Prelude                 hiding ( appendFile )
-import           System.Exit
-import           URI.ByteString          hiding ( uriParser )
-
-import qualified Data.Text                     as T
-
-
-
-
-    ----------------
-    --[ Commands ]--
-    ----------------
-
-
-data TestCommand = TestGHC TestOptions
-
-
-
-
-    ---------------
-    --[ Options ]--
-    ---------------
-
-
-data TestOptions = TestOptions
-  { testVer      :: Maybe ToolVersion
-  , testBindist  :: Maybe URI
-  , addMakeArgs  :: [T.Text]
-  }
-
-
-
-    ---------------
-    --[ Footers ]--
-    ---------------
-
-testFooter :: String
-testFooter = [s|Discussion:
-  Runs test suites from the test bindist.|]
-
-
-
-
-    ---------------
-    --[ Parsers ]--
-    ---------------
-
-testParser :: Parser TestCommand
-testParser =
-  subparser
-      (  command
-          "ghc"
-          (   TestGHC
-          <$> info
-                (testOpts (Just GHC) <**> helper)
-                (  progDesc "Test GHC"
-                <> footerDoc (Just $ text testGHCFooter)
-                )
-          )
-        )
- where
-  testGHCFooter :: String
-  testGHCFooter = [s|Discussion:
-  Runs the GHC test suite from the test bindist.|]
-
-
-testOpts :: Maybe Tool -> Parser TestOptions
-testOpts tool =
-  (\(u, v) args -> TestOptions v u args)
-    <$> (   (   (,)
-            <$> optional
-                  (option
-                    (eitherReader uriParser)
-                    (short 'u' <> long "url" <> metavar "BINDIST_URL" <> help
-                      "Install the specified version from this bindist"
-                      <> completer (toolDlCompleter (fromMaybe GHC tool))
-                    )
-                  )
-            <*> (Just <$> toolVersionTagArgument Nothing tool)
-            )
-        <|> pure (Nothing, Nothing)
-        )
-    <*> many (argument str (metavar "MAKE_ARGS" <> help "Additional arguments to 'make', prefix with '-- ' (longopts)"))
-
-
-
-
-
-
-
-    ---------------------------
-    --[ Effect interpreters ]--
-    ---------------------------
-
-
-type TestGHCEffects = [ DigestError
-                      , ContentLengthError
-                      , GPGError
-                      , DownloadFailed
-                      , NoDownload
-                      , ArchiveResult
-                      , TarDirDoesNotExist
-                      , UnknownArchive
-                      , TestFailed
-                      , NextVerNotFound
-                      , TagNotFound
-                      , NoToolVersionSet
-                      ]
-
-runTestGHC :: AppState
-           -> Excepts TestGHCEffects (ResourceT (ReaderT AppState IO)) a
-           -> IO (VEither TestGHCEffects a)
-runTestGHC appstate' =
-  flip runReaderT appstate'
-  . runResourceT
-  . runE
-    @TestGHCEffects
-
-
-    -------------------
-    --[ Entrypoints ]--
-    -------------------
-
-
-test :: TestCommand -> Settings -> IO AppState -> (ReaderT LeanAppState IO () -> IO ()) -> IO ExitCode
-test testCommand settings getAppState' runLogger = case testCommand of
-  (TestGHC iopts) -> go iopts
- where
-  go :: TestOptions -> IO ExitCode
-  go TestOptions{..} = do
-    s'@AppState{ dirs = Dirs{ .. } } <- liftIO getAppState'
-    (case testBindist of
-       Nothing -> runTestGHC s' $ do
-         (v, vi) <- liftE $ fromVersion testVer GHC
-         liftE $ testGHCVer (_tvVersion v) addMakeArgs
-         pure vi
-       Just uri -> do
-         runTestGHC s'{ settings = settings {noVerify = True}} $ do
-           (v, vi) <- liftE $ fromVersion testVer GHC
-           liftE $ testGHCBindist (DownloadInfo uri (Just $ RegexDir ".*/.*") "" Nothing) (_tvVersion v) addMakeArgs
-           pure vi
-      )
-        >>= \case
-              VRight _ -> do
-                runLogger $ logInfo "GHC test successful"
-                pure ExitSuccess
-              VLeft e -> do
-                runLogger $ do
-                  logError $ T.pack $ prettyHFError e
-                  logError $ "Also check the logs in " <> T.pack (fromGHCupPath logsDir)
-                pure $ ExitFailure 3
-

app/ghcup/GHCup/OptParse/ToolRequirements.hs

@@ -11,8 +11,8 @@ module GHCup.OptParse.ToolRequirements where
 
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -23,13 +23,14 @@ 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
 import Control.Exception.Safe (MonadMask)
 import GHCup.Types.Optics
 import GHCup.Platform
-import GHCup.Prelude
+import GHCup.Utils.Prelude
 import GHCup.Requirements
 import System.IO
 
@@ -117,5 +118,5 @@ toolRequirements ToolReqOpts{..} runAppState runLogger = runToolRequirements run
     >>= \case
           VRight _ -> pure ExitSuccess
           VLeft  e -> do
-            runLogger $ logError $ T.pack $ prettyHFError e
+            runLogger $ logError $ T.pack $ prettyShow e
             pure $ ExitFailure 12

app/ghcup/GHCup/OptParse/UnSet.hs

@@ -16,8 +16,8 @@ module GHCup.OptParse.UnSet where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -31,6 +31,7 @@ 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)
@@ -188,7 +189,7 @@ unset unsetCommand runLeanAppState runLogger = case unsetCommand of
                 runLogger $ logInfo "GHC successfully unset"
                 pure ExitSuccess
               VLeft  e -> do
-                runLogger $ logError $ T.pack $ prettyHFError e
+                runLogger $ logError $ T.pack $ prettyShow e
                 pure $ ExitFailure 14
   (UnsetCabal (UnsetOptions _)) -> do
     void $ runLeanAppState (VRight <$> unsetCabal)

app/ghcup/GHCup/OptParse/Upgrade.hs

@@ -14,8 +14,7 @@ module GHCup.OptParse.Upgrade where
 import           GHCup
 import           GHCup.Errors
 import           GHCup.Types
-import           GHCup.Prelude.File
-import           GHCup.Prelude.Logger
+import           GHCup.Utils.Logger
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -28,6 +27,7 @@ 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)
@@ -87,14 +87,13 @@ upgradeOptsP =
 
 
 type UpgradeEffects = '[ DigestError
-                       , ContentLengthError
                        , GPGError
                        , NoDownload
                        , NoUpdate
                        , FileDoesNotExistError
                        , CopyError
                        , DownloadFailed
-                       , ToolShadowed
+                       , GHCupShadowed
                        ]
 
 
@@ -151,5 +150,5 @@ upgrade uOpts force' fatal Dirs{..} runAppState runLogger = do
         runLogger $ logWarn "No GHCup update available"
         pure ExitSuccess
       VLeft e -> do
-        runLogger $ logError $ T.pack $ prettyHFError e
+        runLogger $ logError $ T.pack $ prettyShow e
         pure $ ExitFailure 11

app/ghcup/GHCup/OptParse/Whereis.hs

@@ -18,8 +18,8 @@ import           GHCup.Errors
 import           GHCup.OptParse.Common
 import           GHCup.Types
 import           GHCup.Utils
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )
@@ -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)
@@ -75,14 +75,14 @@ data WhereisOptions = WhereisOptions {
     --[ Parsers ]--
     ---------------
 
-
+          
 whereisP :: Parser WhereisCommand
 whereisP = subparser
-  (commandGroup "Tools locations:" <>
+  (commandGroup "Tools locations:" <> 
     command
       "ghc"
       (WhereisTool GHC <$> info
-        ( optional (toolVersionTagArgument Nothing (Just GHC)) <**> helper )
+        ( optional (toolVersionArgument Nothing (Just GHC)) <**> helper )
         ( progDesc "Get GHC location"
         <> footerDoc (Just $ text whereisGHCFooter ))
       )
@@ -90,7 +90,7 @@ whereisP = subparser
      command
       "cabal"
       (WhereisTool Cabal <$> info
-        ( optional (toolVersionTagArgument Nothing (Just Cabal)) <**> helper )
+        ( optional (toolVersionArgument Nothing (Just Cabal)) <**> helper )
         ( progDesc "Get cabal location"
         <> footerDoc (Just $ text whereisCabalFooter ))
       )
@@ -98,7 +98,7 @@ whereisP = subparser
      command
       "hls"
       (WhereisTool HLS <$> info
-        ( optional (toolVersionTagArgument Nothing (Just HLS)) <**> helper )
+        ( optional (toolVersionArgument Nothing (Just HLS)) <**> helper )
         ( progDesc "Get HLS location"
         <> footerDoc (Just $ text whereisHLSFooter ))
       )
@@ -106,7 +106,7 @@ whereisP = subparser
      command
       "stack"
       (WhereisTool Stack <$> info
-        ( optional (toolVersionTagArgument Nothing (Just Stack)) <**> helper )
+        ( optional (toolVersionArgument Nothing (Just Stack)) <**> helper )
         ( progDesc "Get stack location"
         <> footerDoc (Just $ text whereisStackFooter ))
       )
@@ -268,14 +268,7 @@ 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{..}) ->
+    (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
       runLeanWhereIs leanAppstate (do
         loc <- liftE $ whereIsTool tool v
         if directory
@@ -287,21 +280,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
                 liftIO $ putStr r
                 pure ExitSuccess
               VLeft e -> do
-                runLogger $ logError $ T.pack $ prettyHFError e
-                pure $ ExitFailure 30
-    (WhereisTool tool (Just (ToolVersion v)), WhereisOptions{..}) ->
-      runLeanWhereIs leanAppstate (do
-        loc <- liftE $ whereIsTool tool (mkTVer v)
-        if directory
-        then pure $ takeDirectory loc
-        else pure loc
-        )
-        >>= \case
-              VRight r -> do
-                liftIO $ putStr r
-                pure ExitSuccess
-              VLeft e -> do
-                runLogger $ logError $ T.pack $ prettyHFError e
+                runLogger $ logError $ T.pack $ prettyShow e
                 pure $ ExitFailure 30
 
     (WhereisTool tool whereVer, WhereisOptions{..}) -> do
@@ -317,7 +296,7 @@ whereis whereisCommand whereisOptions runAppState leanAppstate runLogger = do
                 liftIO $ putStr r
                 pure ExitSuccess
               VLeft e -> do
-                runLogger $ logError $ T.pack $ prettyHFError e
+                runLogger $ logError $ T.pack $ prettyShow e
                 pure $ ExitFailure 30
 
     (WhereisBaseDir, _) -> do

app/ghcup/Main.hs

@@ -14,8 +14,6 @@ module Main where
 import           BrickMain                    ( brickMain )
 #endif
 
-import qualified GHCup.GHC as GHC
-import qualified GHCup.HLS as HLS
 import           GHCup.OptParse
 
 import           GHCup.Download
@@ -24,9 +22,9 @@ import           GHCup.Platform
 import           GHCup.Types
 import           GHCup.Types.Optics      hiding ( toolRequirements )
 import           GHCup.Utils
-import           GHCup.Prelude
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.Logger
+import           GHCup.Utils.Prelude
+import           GHCup.Utils.String.QQ
 import           GHCup.Version
 
 import           Cabal.Plan ( findPlanJson, SearchPlanJson(..) )
@@ -79,7 +77,6 @@ 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
@@ -88,7 +85,6 @@ 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
@@ -159,10 +155,11 @@ main = do
   versions. It maintains a self-contained ~/.ghcup directory.
 
 ENV variables:
+  * TMPDIR: where ghcup does the work (unpacking, building, ...)
   * 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://github.com/haskell/ghcup-hs/issues>|]
+Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
 
   customExecParser
       (prefs showHelpOnError)
@@ -200,25 +197,25 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
 
 
           let appState = do
-                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)
+                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)
 
                 ghcupInfo <-
                   ( flip runReaderT leanAppstate
-                    . runE @'[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
+                    . runE @'[DigestError, GPGError, JSONError , DownloadFailed, FileDoesNotExistError]
                     $ liftE getDownloadsF
                     )
                     >>= \case
                           VRight r -> pure r
                           VLeft  e -> do
                             runLogger
-                              (logError $ T.pack $ prettyHFError e)
+                              (logError $ T.pack $ prettyShow e)
                             exitWith (ExitFailure 2)
                 let s' = AppState settings dirs keybindings ghcupInfo pfreq loggerConfig
 
@@ -240,7 +237,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                     | Just False <- optVerbose -> pure ()
                     | otherwise -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
                          Nothing -> void . flip runReaderT s' . runE @'[TagNotFound, NextVerNotFound, NoToolVersionSet] $ do
-                           newTools <- lift checkForUpdates
+                           newTools <- lift checkForUpdates 
                            forM_ newTools $ \newTool@(t, l) -> do
                              -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/283
                              alreadyInstalling' <- alreadyInstalling optCommand newTool
@@ -254,7 +251,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                                         logWarn ("New "
                                           <> T.pack (prettyShow t)
                                           <> " version available. "
-                                          <> "If you want to install this latest version, run 'ghcup install "
+                                          <> "To upgrade, run 'ghcup install "
                                           <> T.pack (prettyShow t)
                                           <> " "
                                           <> prettyVer l
@@ -266,7 +263,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                   VRight _ -> pure ()
                   VLeft e -> do
                     runLogger
-                      (logError $ T.pack $ prettyHFError e)
+                      (logError $ T.pack $ prettyShow e)
                     exitWith (ExitFailure 30)
                 pure s'
 
@@ -281,7 +278,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
               runAppState action' = do
                 s' <- liftIO appState
                 runReaderT action' s'
-
+                  
 
           -----------------
           -- Run command --
@@ -295,7 +292,6 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
 #endif
             Install installCommand     -> install installCommand settings appState runLogger
             InstallCabalLegacy iopts   -> install (Left (InstallCabal iopts)) settings appState runLogger
-            Test testCommand           -> test testCommand settings appState runLogger
             Set setCommand             -> set setCommand runAppState runLeanAppState runLogger
             UnSet unsetCommand         -> unset unsetCommand runLeanAppState runLogger
             List lo                    -> list lo no_color runAppState
@@ -312,7 +308,6 @@ Report bugs at <https://github.com/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 ()
@@ -343,16 +338,14 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
   alreadyInstalling (Install (Left (InstallHLS InstallOptions{..})))     (HLS, ver)   = cmp' HLS instVer ver
   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 = 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 = 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
+    (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer over)) ver
+  alreadyInstalling (Compile (CompileGHC GHCCompileOptions{ targetGhc = Left tver }))
+    (GHC, ver)   = cmp' GHC (Just $ ToolVersion (mkTVer tver)) ver
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ ovewrwiteVer = Just over }))
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
+  alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
+    (HLS, ver)   = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
+  alreadyInstalling (Upgrade _ _ _) (GHCup, _) = pure True
   alreadyInstalling _ _ = pure False
 
   cmp' :: ( HasLog env

cabal.ghc8107.project

@@ -15,7 +15,7 @@ source-repository-package
 
 constraints: http-io-streams -brotli,
              any.Cabal ==3.6.2.0,
-             any.aeson >= 2.0.1.0,
+             any.aeson >= 2.0.1.0
 
 package libarchive
   flags: -system-libarchive
@@ -29,9 +29,6 @@ package cabal-plan
 package aeson
   flags: +ordered-keymap
 
-package streamly
-  flags: +use-unliftio
-
 allow-newer: base, ghc-prim, template-haskell, language-c
 
 with-compiler: ghc-8.10.7

cabal.ghc8107.project.freeze

@@ -15,7 +15,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
              any.alex ==3.2.7.1,
-             any.ansi-terminal ==0.11.3,
+             any.ansi-terminal ==0.11.1,
              ansi-terminal -example,
              any.ansi-wl-pprint ==0.6.9,
              ansi-wl-pprint -example,
@@ -33,7 +33,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.base-orphans ==0.8.6,
              any.base16-bytestring ==1.0.2.0,
              any.base64-bytestring ==1.2.1.0,
-             any.bifunctors ==5.5.12,
+             any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
              any.blaze-builder ==0.4.2.2,
@@ -80,9 +80,9 @@ constraints: any.Cabal ==3.6.2.0,
              dlist -werror,
              any.exceptions ==0.10.4,
              any.filepath ==1.4.2.1,
-             any.free ==5.1.8,
+             any.free ==5.1.7,
              any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.2.2,
+             any.generic-arbitrary ==0.2.0,
              any.ghc ==8.10.7,
              any.ghc-boot ==8.10.7,
              any.ghc-boot-th ==8.10.7,
@@ -100,12 +100,12 @@ constraints: any.Cabal ==3.6.2.0,
              any.hpc ==0.6.1.0,
              any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.9.7,
-             any.hspec-core ==2.9.7,
-             any.hspec-discover ==2.9.7,
+             any.hspec ==2.9.4,
+             any.hspec-core ==2.9.4,
+             any.hspec-discover ==2.9.4,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
-             any.http-io-streams ==0.1.6.1,
+             any.http-io-streams ==0.1.6.0,
              http-io-streams -brotli +fast-xor,
              any.indexed-profunctors ==0.1.1,
              any.indexed-traversable ==0.1.2,
@@ -115,7 +115,7 @@ constraints: any.Cabal ==3.6.2.0,
              integer-logarithms -check-bounds +integer-gmp,
              any.io-streams ==1.5.2.1,
              io-streams +network -nointeractivetests +zlib,
-             any.language-c ==0.9.1,
+             any.language-c ==0.9.0.1,
              language-c -allwarnings +iecfpextension +usebytestrings,
              any.libarchive ==3.0.3.2,
              libarchive -cross -low-memory +no-exe -system-libarchive,
@@ -123,21 +123,22 @@ constraints: any.Cabal ==3.6.2.0,
              libyaml-streamly -no-unicode -system-libyaml,
              any.lockfree-queue ==0.2.3.1,
              any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.2.1,
+             any.megaparsec ==9.2.0,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
-             any.microlens-mtl ==0.2.0.2,
+             any.microlens-mtl ==0.2.0.1,
              any.microlens-th ==0.4.3.10,
+             any.monad-control ==1.0.3.1,
              any.mtl ==2.2.2,
              any.network ==3.1.2.7,
              network -devel,
              any.network-uri ==2.6.4.1,
              any.openssl-streams ==1.2.3.0,
-             any.optics ==0.4.2,
-             any.optics-core ==0.4.1,
+             any.optics ==0.4,
+             any.optics-core ==0.4,
              optics-core -explicit-generic-labels,
-             any.optics-extra ==0.4.2.1,
-             any.optics-th ==0.4.1,
+             any.optics-extra ==0.4,
+             any.optics-th ==0.4,
              any.optparse-applicative ==0.17.0.0,
              optparse-applicative +process,
              any.os-release ==1.0.2.1,
@@ -149,23 +150,23 @@ constraints: any.Cabal ==3.6.2.0,
              any.polyparse ==1.13,
              any.pretty ==1.1.3.6,
              any.pretty-terminal ==0.1.0.0,
-             any.primitive ==0.7.4.0,
+             any.primitive ==0.7.3.0,
              any.process ==1.6.13.2,
              any.profunctors ==5.6.2,
              any.quickcheck-arbitrary-adt ==0.3.1.0,
              any.quickcheck-io ==0.2.0,
-             any.random ==1.2.1.1,
+             any.random ==1.2.1,
              any.recursion-schemes ==5.2.2.2,
              recursion-schemes +template-haskell,
              any.regex-base ==0.94.0.2,
              any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
-             any.resourcet ==1.2.5,
+             any.resourcet ==1.2.4.3,
              any.retry ==0.8.1.2,
              retry -lib-werror,
              any.rts ==1.0.1,
              any.safe ==0.3.19,
-             any.safe-exceptions ==0.1.7.3,
+             any.safe-exceptions ==0.1.7.2,
              any.scientific ==0.3.7.0,
              scientific -bytestring-builder -integer-simple,
              any.semialign ==1.2.0.1,
@@ -178,7 +179,7 @@ constraints: any.Cabal ==3.6.2.0,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.1,
              any.streamly ==0.8.2,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
+             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
@@ -212,11 +213,11 @@ constraints: any.Cabal ==3.6.2.0,
              any.unicode-data ==0.3.0,
              unicode-data -ucd2haskell,
              any.unix ==2.7.2.2,
-             any.unix-bytestring ==0.3.7.7,
-             any.unix-compat ==0.6,
+             any.unix-bytestring ==0.3.7.6,
+             any.unix-compat ==0.5.4,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.19.1,
+             any.unordered-containers ==0.2.17.0,
              unordered-containers -debug,
              any.uri-bytestring ==0.3.3.1,
              uri-bytestring -lib-werror,
@@ -232,7 +233,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.xor ==0.0.1.1,
              any.yaml-streamly ==0.12.1,
              yaml-streamly +no-examples +no-exe,
-             any.zlib ==0.6.3.0,
+             any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2022-06-04T19:47:01Z
+index-state: hackage.haskell.org 2022-03-15T16:43:02Z

cabal.ghc902.project

@@ -15,7 +15,7 @@ source-repository-package
 
 constraints: http-io-streams -brotli,
              any.Cabal ==3.6.2.0,
-             any.aeson >= 2.0.1.0,
+             any.aeson >= 2.0.1.0
 
 package libarchive
   flags: -system-libarchive
@@ -29,9 +29,6 @@ package cabal-plan
 package aeson
   flags: +ordered-keymap
 
-package streamly
-  flags: +use-unliftio
-
 allow-newer: base, ghc-prim, template-haskell, language-c
 
 with-compiler: ghc-9.0.2

cabal.ghc902.project.freeze

@@ -15,7 +15,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
              any.alex ==3.2.7.1,
-             any.ansi-terminal ==0.11.3,
+             any.ansi-terminal ==0.11.1,
              ansi-terminal -example,
              any.ansi-wl-pprint ==0.6.9,
              ansi-wl-pprint -example,
@@ -33,7 +33,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.base-orphans ==0.8.6,
              any.base16-bytestring ==1.0.2.0,
              any.base64-bytestring ==1.2.1.0,
-             any.bifunctors ==5.5.12,
+             any.bifunctors ==5.5.11,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
              any.blaze-builder ==0.4.2.2,
@@ -80,9 +80,9 @@ constraints: any.Cabal ==3.6.2.0,
              dlist -werror,
              any.exceptions ==0.10.4,
              any.filepath ==1.4.2.1,
-             any.free ==5.1.8,
+             any.free ==5.1.7,
              any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.2.2,
+             any.generic-arbitrary ==0.2.0,
              any.ghc ==9.0.2,
              any.ghc-bignum ==1.1,
              any.ghc-boot ==9.0.2,
@@ -101,12 +101,12 @@ constraints: any.Cabal ==3.6.2.0,
              any.hpc ==0.6.1.0,
              any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.9.7,
-             any.hspec-core ==2.9.7,
-             any.hspec-discover ==2.9.7,
+             any.hspec ==2.9.4,
+             any.hspec-core ==2.9.4,
+             any.hspec-discover ==2.9.4,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
-             any.http-io-streams ==0.1.6.1,
+             any.http-io-streams ==0.1.6.0,
              http-io-streams -brotli +fast-xor,
              any.indexed-profunctors ==0.1.1,
              any.indexed-traversable ==0.1.2,
@@ -115,7 +115,7 @@ constraints: any.Cabal ==3.6.2.0,
              integer-logarithms -check-bounds +integer-gmp,
              any.io-streams ==1.5.2.1,
              io-streams +network -nointeractivetests +zlib,
-             any.language-c ==0.9.1,
+             any.language-c ==0.9.0.1,
              language-c -allwarnings +iecfpextension +usebytestrings,
              any.libarchive ==3.0.3.2,
              libarchive -cross -low-memory +no-exe -system-libarchive,
@@ -123,21 +123,22 @@ constraints: any.Cabal ==3.6.2.0,
              libyaml-streamly -no-unicode -system-libyaml,
              any.lockfree-queue ==0.2.3.1,
              any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.2.1,
+             any.megaparsec ==9.2.0,
              megaparsec -dev,
              any.microlens ==0.4.12.0,
-             any.microlens-mtl ==0.2.0.2,
+             any.microlens-mtl ==0.2.0.1,
              any.microlens-th ==0.4.3.10,
+             any.monad-control ==1.0.3.1,
              any.mtl ==2.2.2,
              any.network ==3.1.2.7,
              network -devel,
              any.network-uri ==2.6.4.1,
              any.openssl-streams ==1.2.3.0,
-             any.optics ==0.4.2,
-             any.optics-core ==0.4.1,
+             any.optics ==0.4,
+             any.optics-core ==0.4,
              optics-core -explicit-generic-labels,
-             any.optics-extra ==0.4.2.1,
-             any.optics-th ==0.4.1,
+             any.optics-extra ==0.4,
+             any.optics-th ==0.4,
              any.optparse-applicative ==0.17.0.0,
              optparse-applicative +process,
              any.os-release ==1.0.2.1,
@@ -149,23 +150,23 @@ constraints: any.Cabal ==3.6.2.0,
              any.polyparse ==1.13,
              any.pretty ==1.1.3.6,
              any.pretty-terminal ==0.1.0.0,
-             any.primitive ==0.7.4.0,
+             any.primitive ==0.7.3.0,
              any.process ==1.6.13.2,
              any.profunctors ==5.6.2,
              any.quickcheck-arbitrary-adt ==0.3.1.0,
              any.quickcheck-io ==0.2.0,
-             any.random ==1.2.1.1,
+             any.random ==1.2.1,
              any.recursion-schemes ==5.2.2.2,
              recursion-schemes +template-haskell,
              any.regex-base ==0.94.0.2,
              any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
-             any.resourcet ==1.2.5,
+             any.resourcet ==1.2.4.3,
              any.retry ==0.8.1.2,
              retry -lib-werror,
              any.rts ==1.0.2,
              any.safe ==0.3.19,
-             any.safe-exceptions ==0.1.7.3,
+             any.safe-exceptions ==0.1.7.2,
              any.scientific ==0.3.7.0,
              scientific -bytestring-builder -integer-simple,
              any.semialign ==1.2.0.1,
@@ -178,7 +179,7 @@ constraints: any.Cabal ==3.6.2.0,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.0,
              any.streamly ==0.8.2,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
+             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc -use-unliftio,
              any.strict ==0.4.0.1,
              strict +assoc,
              any.strict-base ==0.4.0.0,
@@ -212,11 +213,11 @@ constraints: any.Cabal ==3.6.2.0,
              any.unicode-data ==0.3.0,
              unicode-data -ucd2haskell,
              any.unix ==2.7.2.2,
-             any.unix-bytestring ==0.3.7.7,
-             any.unix-compat ==0.6,
+             any.unix-bytestring ==0.3.7.6,
+             any.unix-compat ==0.5.4,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.19.1,
+             any.unordered-containers ==0.2.17.0,
              unordered-containers -debug,
              any.uri-bytestring ==0.3.3.1,
              uri-bytestring -lib-werror,
@@ -232,7 +233,7 @@ constraints: any.Cabal ==3.6.2.0,
              any.xor ==0.0.1.1,
              any.yaml-streamly ==0.12.1,
              yaml-streamly +no-examples +no-exe,
-             any.zlib ==0.6.3.0,
+             any.zlib ==0.6.2.3,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2022-06-04T19:47:01Z
+index-state: hackage.haskell.org 2022-03-15T16:43:02Z

cabal.ghc923.project

@@ -1,37 +0,0 @@
-packages: ./ghcup.cabal
-
-optional-packages: ./vendored/*/*.cabal
-
-optimization: 2
-
-package ghcup
-    tests: True
-    flags: +tui
-
-source-repository-package
-  type: git
-  location: https://github.com/bgamari/terminal-size.git
-  tag: 34ea816bd63f75f800eedac12c6908c6f3736036
-
-constraints: http-io-streams -brotli,
-             any.Cabal ==3.6.2.0,
-             any.aeson >= 2.0.1.0,
-
-package libarchive
-  flags: -system-libarchive
-
-package aeson-pretty
-  flags: +lib-only
-
-package cabal-plan
-  flags: -exe
-
-package aeson
-  flags: +ordered-keymap
-
-package streamly
-  flags: +use-unliftio
-
-allow-newer: base, ghc-prim, template-haskell, language-c
-
-with-compiler: ghc-9.2.3

cabal.ghc923.project.freeze

@@ -1,233 +0,0 @@
-active-repositories: hackage.haskell.org:merge
-constraints: any.Cabal ==3.6.2.0,
-             Cabal -bundled-binary-generic,
-             any.HUnit ==1.6.2.0,
-             any.HsOpenSSL ==0.11.7.2,
-             HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
-             any.OneTuple ==0.3.1,
-             any.QuickCheck ==2.14.2,
-             QuickCheck -old-random +templatehaskell,
-             any.StateVar ==1.2.2,
-             any.abstract-deque ==0.3,
-             abstract-deque -usecas,
-             any.aeson ==2.0.3.0,
-             aeson -cffi +ordered-keymap,
-             any.aeson-pretty ==0.8.9,
-             aeson-pretty +lib-only,
-             any.alex ==3.2.7.1,
-             any.ansi-terminal ==0.11.3,
-             ansi-terminal -example,
-             any.ansi-wl-pprint ==0.6.9,
-             ansi-wl-pprint -example,
-             any.array ==0.5.4.0,
-             any.assoc ==1.0.2,
-             any.async ==2.2.4,
-             async -bench,
-             any.atomic-primops ==0.8.4,
-             atomic-primops -debug,
-             any.attoparsec ==0.14.4,
-             attoparsec -developer,
-             any.base ==4.16.2.0,
-             any.base-compat ==0.12.1,
-             any.base-compat-batteries ==0.12.1,
-             any.base-orphans ==0.8.6,
-             any.base16-bytestring ==1.0.2.0,
-             any.base64-bytestring ==1.2.1.0,
-             any.bifunctors ==5.5.12,
-             bifunctors +semigroups +tagged,
-             any.binary ==0.8.9.0,
-             any.blaze-builder ==0.4.2.2,
-             any.brick ==0.64.2,
-             brick -demos,
-             any.bytestring ==0.11.3.1,
-             any.bz2 ==1.0.1.0,
-             bz2 -cross +with-bzlib,
-             any.c2hs ==0.28.8,
-             c2hs +base3 -regression,
-             any.cabal-plan ==0.7.2.1,
-             cabal-plan -_ -exe -license-report,
-             any.call-stack ==0.4.0,
-             any.case-insensitive ==1.2.1.0,
-             any.casing ==0.1.4.1,
-             any.chs-cabal ==0.1.1.1,
-             any.chs-deps ==0.1.0.0,
-             chs-deps -cross,
-             any.clock ==0.8.3,
-             clock -llvm,
-             any.colour ==2.3.6,
-             any.comonad ==5.0.8,
-             comonad +containers +distributive +indexed-traversable,
-             any.composition-prelude ==3.0.0.2,
-             composition-prelude -development,
-             any.config-ini ==0.2.4.0,
-             config-ini -enable-doctests,
-             any.containers ==0.6.5.1,
-             any.contravariant ==1.5.5,
-             contravariant +semigroups +statevar +tagged,
-             any.cpphs ==1.20.9.1,
-             cpphs -old-locale,
-             any.cryptohash-sha1 ==0.11.101.0,
-             any.cryptohash-sha256 ==0.11.102.1,
-             cryptohash-sha256 -exe +use-cbits,
-             any.data-clist ==0.2,
-             any.data-fix ==0.3.2,
-             any.deepseq ==1.4.6.1,
-             any.directory ==1.3.7.0,
-             any.disk-free-space ==0.1.0.1,
-             any.distributive ==0.6.2.1,
-             distributive +semigroups +tagged,
-             any.dlist ==1.0,
-             dlist -werror,
-             any.exceptions ==0.10.4,
-             any.filepath ==1.4.2.2,
-             any.free ==5.1.8,
-             any.fusion-plugin-types ==0.1.0,
-             any.generic-arbitrary ==0.2.2,
-             any.ghc-bignum ==1.2,
-             any.ghc-boot-th ==9.2.3,
-             any.ghc-byteorder ==4.11.0.0.10,
-             any.ghc-prim ==0.8.0,
-             any.happy ==1.20.0,
-             any.hashable ==1.4.0.2,
-             hashable +containers +integer-gmp -random-initial-seed,
-             any.haskus-utils-data ==1.4,
-             any.haskus-utils-types ==1.5.1,
-             any.haskus-utils-variant ==3.2.1,
-             any.heaps ==0.4,
-             any.hsc2hs ==0.68.8,
-             hsc2hs -in-ghc-tree,
-             any.hspec ==2.9.2,
-             any.hspec-core ==2.9.2,
-             any.hspec-discover ==2.9.2,
-             any.hspec-expectations ==0.8.2,
-             any.hspec-golden-aeson ==0.9.0.0,
-             any.http-io-streams ==0.1.6.1,
-             http-io-streams -brotli +fast-xor,
-             any.indexed-profunctors ==0.1.1,
-             any.indexed-traversable ==0.1.2,
-             any.indexed-traversable-instances ==0.1.1,
-             any.integer-logarithms ==1.0.3.1,
-             integer-logarithms -check-bounds +integer-gmp,
-             any.io-streams ==1.5.2.1,
-             io-streams +network -nointeractivetests +zlib,
-             any.language-c ==0.9.1,
-             language-c -allwarnings +iecfpextension +usebytestrings,
-             any.libarchive ==3.0.3.2,
-             libarchive -cross -low-memory +no-exe -system-libarchive,
-             any.libyaml-streamly ==0.2.1,
-             libyaml-streamly -no-unicode -system-libyaml,
-             any.lockfree-queue ==0.2.3.1,
-             any.lzma-static ==5.2.5.4,
-             any.megaparsec ==9.2.1,
-             megaparsec -dev,
-             any.microlens ==0.4.12.0,
-             any.microlens-mtl ==0.2.0.2,
-             any.microlens-th ==0.4.3.10,
-             any.mtl ==2.2.2,
-             any.network ==3.1.2.7,
-             network -devel,
-             any.network-uri ==2.6.4.1,
-             any.openssl-streams ==1.2.3.0,
-             any.optics ==0.4.2,
-             any.optics-core ==0.4.1,
-             optics-core -explicit-generic-labels,
-             any.optics-extra ==0.4.2.1,
-             any.optics-th ==0.4.1,
-             any.optparse-applicative ==0.17.0.0,
-             optparse-applicative +process,
-             any.os-release ==1.0.2.1,
-             os-release -devel,
-             any.parallel ==3.2.2.0,
-             any.parsec ==3.1.15.0,
-             any.parser-combinators ==1.3.0,
-             parser-combinators -dev,
-             any.polyparse ==1.13,
-             any.pretty ==1.1.3.6,
-             any.pretty-terminal ==0.1.0.0,
-             any.primitive ==0.7.4.0,
-             any.process ==1.6.14.0,
-             any.profunctors ==5.6.2,
-             any.quickcheck-arbitrary-adt ==0.3.1.0,
-             any.quickcheck-io ==0.2.0,
-             any.random ==1.2.1.1,
-             any.recursion-schemes ==5.2.2.2,
-             recursion-schemes +template-haskell,
-             any.regex-base ==0.94.0.2,
-             any.regex-posix ==0.96.0.1,
-             regex-posix -_regex-posix-clib,
-             any.resourcet ==1.2.5,
-             any.retry ==0.8.1.2,
-             retry -lib-werror,
-             any.rts ==1.0.2,
-             any.safe ==0.3.19,
-             any.safe-exceptions ==0.1.7.3,
-             any.scientific ==0.3.7.0,
-             scientific -bytestring-builder -integer-simple,
-             any.semialign ==1.2.0.1,
-             semialign +semigroupoids,
-             any.semigroupoids ==5.3.7,
-             semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
-             any.setenv ==0.1.1.3,
-             any.split ==0.2.3.4,
-             any.splitmix ==0.1.0.4,
-             splitmix -optimised-mixer,
-             any.stm ==2.5.0.2,
-             any.streamly ==0.8.2,
-             streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
-             any.strict ==0.4.0.1,
-             strict +assoc,
-             any.strict-base ==0.4.0.0,
-             any.tagged ==0.8.6.1,
-             tagged +deepseq +transformers,
-             any.tagsoup ==0.14.8,
-             any.template-haskell ==2.18.0.0,
-             any.temporary ==1.3,
-             any.terminal-progress-bar ==0.4.1,
-             any.terminal-size ==0.3.2.1,
-             any.terminfo ==0.4.1.5,
-             any.text ==1.2.5.0,
-             any.text-short ==0.1.5,
-             text-short -asserts,
-             any.text-zipper ==0.11,
-             any.tf-random ==0.5,
-             any.th-abstraction ==0.4.3.0,
-             any.th-compat ==0.1.3,
-             any.th-lift ==0.8.2,
-             any.th-lift-instances ==0.1.19,
-             any.these ==1.1.1.1,
-             these +assoc,
-             any.time ==1.9.3,
-             any.time-compat ==1.9.6.1,
-             time-compat -old-locale,
-             any.transformers ==0.5.6.2,
-             any.transformers-base ==0.4.6,
-             transformers-base +orphaninstances,
-             any.transformers-compat ==0.7.1,
-             transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
-             any.unicode-data ==0.3.0,
-             unicode-data -ucd2haskell,
-             any.unix ==2.7.2.2,
-             any.unix-bytestring ==0.3.7.7,
-             any.unix-compat ==0.6,
-             unix-compat -old-time,
-             any.unliftio-core ==0.2.0.1,
-             any.unordered-containers ==0.2.19.1,
-             unordered-containers -debug,
-             any.uri-bytestring ==0.3.3.1,
-             uri-bytestring -lib-werror,
-             any.utf8-string ==1.0.2,
-             any.uuid-types ==1.0.5,
-             any.vector ==0.12.3.1,
-             vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.versions ==5.0.3,
-             any.vty ==5.33,
-             any.witherable ==0.4.2,
-             any.word-wrap ==0.5,
-             any.word8 ==0.1.3,
-             any.xor ==0.0.1.1,
-             any.yaml-streamly ==0.12.1,
-             yaml-streamly +no-examples +no-exe,
-             any.zlib ==0.6.3.0,
-             zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
-             any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2022-06-04T19:47:01Z

cabal.project

@@ -5,6 +5,7 @@ optional-packages: ./vendored/*/*.cabal
 optimization: 2
 
 package ghcup
+    tests: True
     flags: +tui
 
 source-repository-package
@@ -14,7 +15,9 @@ source-repository-package
 
 constraints: http-io-streams -brotli,
              any.Cabal ==3.6.2.0,
-             any.aeson >= 2.0.1.0
+             any.aeson >= 2.0.1.0,
+             -- https://github.com/typeable/generic-arbitrary/issues/14
+             any.generic-arbitrary < 0.2.1
 
 package libarchive
   flags: -system-libarchive

cbits/dirutils.h

@@ -1,7 +1,6 @@
 #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,12 +40,6 @@ 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:
@@ -81,14 +75,3 @@ 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

@@ -1,71 +0,0 @@
-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

@@ -1,71 +0,0 @@
-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

@@ -1,64 +0,0 @@
-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

@@ -1,36 +0,0 @@
-#!/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

@@ -1,64 +0,0 @@
-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

@@ -1,36 +0,0 @@
-#!/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://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 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 donate to the project, visit our [opencollective](https://opencollective.com/ghcup#category-CONTRIBUTE) page
 
 ## Design goals
@@ -60,29 +60,6 @@ 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/`.
@@ -97,16 +74,13 @@ 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:
+	- [actions/virtual-environments](https://github.com/actions/virtual-environments)
+	- [haskell/actions/setup](https://github.com/haskell/actions/tree/main/setup)
 * 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)
+	- [vabal](https://github.com/Franciman/vabal)
 
 ## Known problems
 
@@ -178,11 +152,6 @@ 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://github.com/haskell/ghcup-hs/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://github.com/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://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26](https://gitlab.haskell.org/haskell/ghcup-hs/-/commit/c19dd5ee8b2edbaf0336af143f1c75b6f4843e26)
 
-Every subcommand now lives in its own module under [GHCup.OptParse.MyCommand](https://github.com/haskell/ghcup-hs/tree/master/app/ghcup/GHCup/OptParse).
+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).
 
 ## 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, text-based user interface (TUI) (not available on windows), run:
+For the simple interactive 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://github.com/haskell/ghcup-hs/tree/master/scripts/shell-completions) directory of this repository.
+Shell completions are in [scripts/shell-completions](https://gitlab.haskell.org/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,29 +67,16 @@ 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://github.com/haskell/ghcup-hs/blob/master/data/config.yaml).
+explaining all possible configurations can be found in this repo: [config.yaml](https://gitlab.haskell.org/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:
 
 * `GHCUP_USE_XDG_DIRS`: see [XDG support](#xdg-support) above
+* `TMPDIR`: where ghcup does the work (unpacking, building, ...)
 * `GHCUP_INSTALL_BASE_PREFIX`: the base of ghcup (default: `$HOME`)
 * `GHCUP_CURL_OPTS`: additional options that can be passed to curl
 * `GHCUP_WGET_OPTS`: additional options that can be passed to wget
@@ -97,10 +84,6 @@ 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.
@@ -151,7 +134,7 @@ url-source:
   OwnSource: "https://some-url/ghcup-0.0.6.yaml"
 ```
 
-See [config.yaml](https://github.com/haskell/ghcup-hs/blob/master/data/config.yaml)
+See [config.yaml](https://gitlab.haskell.org/haskell/ghcup-hs/-/blob/master/data/config.yaml)
 for more options.
 
 Alternatively you can do it via a cli switch:
@@ -202,97 +185,8 @@ 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:
@@ -300,8 +194,7 @@ 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 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`
+    - 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`
 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`
 
@@ -310,78 +203,18 @@ 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 from source
-
-### GHC
+## Compiling GHC from source
 
 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://github.com/haskell/ghcup-hs/tree/master/data/build_mk), copy them somewhere, adjust them and
+in [data/build_mk](https://gitlab.haskell.org/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
@@ -409,43 +242,41 @@ 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/ghc/ghc/-/jobs/artifacts/master/raw/ghc-x86_64-linux-fedora33-release.tar.xz?job=x86_64-linux-fedora33-release' head`
+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`
 
-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, as below. The paramaters to the PowerShell script are
-specified positionally, after `-ArgumentList`:
+On windows, ghcup can be installed automatically on a CI runner non-interactively like so:
 
 ```ps
-$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 $_ }
+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'` 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`.
 
-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.
+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)
 
 ### github workflows
 
@@ -457,11 +288,10 @@ GHCup itself is also pre-installed on all platforms, but may use non-standard in
 GHCup supports verifying the GPG signature of the metadata file. The metadata file then contains SHA256 hashes of all downloads, so
 this is cryptographically secure.
 
-First, obtain the gpg keys:
+First, obtain the gpg key:
 
 ```sh
-gpg --batch --keyserver keys.openpgp.org     --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
-gpg --batch --keyserver keyserver.ubuntu.com --recv-keys FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01
+gpg --batch --keyserver keys.openpgp.org --recv-keys 7784930957807690A66EBDBE3786C5262ECB4A3F
 ```
 
 Then verify the gpg key in one of these ways:
@@ -480,7 +310,7 @@ gpg-setting: GPGLax # GPGStrict | GPGLax | GPGNone
 
 In `GPGStrict` mode, ghcup will fail if verification fails. In `GPGLax` mode it will just print a warning.
 You can also pass the mode via `ghcup --gpg <strict|lax|none>`.
-
+   
 # Tips and tricks
 
 ## ghcup run
@@ -494,34 +324,3 @@ ghcup run --ghc 8.10.7 --cabal latest --hls latest --stack latest --install -- c
 ```
 
 This will execute vscode with GHC set to 8.10.7 and all other tools to their latest version.
-
-# Troubleshooting
-
-## Script immediately exits on windows
-
-There are two possible reasons:
-
-1. your company blocks the script (some have a whitelist)... ask your administrator
-2. your Antivirus or Windows Defender interfere with the installation. Disable them temporarily.
-
-## C compiler cannot create executables
-
-### Darwin
-
-You need to update your XCode command line tools, e.g. [like this](https://stackoverflow.com/questions/34617452/how-to-update-xcode-from-command-line).
-
-## Certificate authority errors (curl)
-
-If your certificates are outdated or improperly configured, curl may be unable
-to download ghcup.
-
-There are two known workarounds:
-
-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;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 the main installer for the general purpose language <a href="https://www.haskell.org">Haskell</a>.</p>
+<p class="ghcup-intro">GHCup is an installer for the general purpose language <a href="https://www.haskell.org">Haskell</a>.</p>
 
 <div class="text-center main-buttons">
-<a href="install/" class="btn btn-primary" role="button">Installation</a>
+<a href="install/" class="btn btn-primary" role="button">Getting Started</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://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>
+		<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>
 	</div>
     </div>
 
@@ -45,19 +45,19 @@ 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; try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true } catch { Write-Error $_ }
+          <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>
         </pre>
         <button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
       </div>
 	<div class="footer">
-		<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>
+		<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>
 	</div>
     </div>
 </section>
 
 <p id="help" class="ghcup-help">
-  Need help? Check the <a href="guide/#troubleshooting">Troubleshooting section</a> or ask on
+  Need help? Ask on
   <span>
     <a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup">
       <img src="irc.svg" alt="" />
@@ -77,7 +77,7 @@ hide:
   </span>
    or
    <span>
-     <a href="https://github.com/haskell/ghcup-hs/issues">
+     <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">
        report a bug
        <img src="Octicons-bug.svg" alt="" />
      </a>

docs/install.md

@@ -1,10 +1,10 @@
-# Installation
+# Getting started
 
 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).
 
-## How to install
+## Installation
 
 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; try { Invoke-Command -ScriptBlock ([ScriptBlock]::Create((Invoke-WebRequest https://www.haskell.org/ghcup/sh/bootstrap-haskell.ps1 -UseBasicParsing))) -ArgumentList $true } catch { Write-Error $_ }
+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
 ```
 
 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://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.
+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.
 
 ### Which versions get installed?
 
@@ -34,53 +34,6 @@ 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
@@ -102,17 +55,11 @@ 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.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.2</td><td><span style="color:blue">latest</span>, 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>base-4.14.3.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.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>
@@ -143,8 +90,7 @@ 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.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.2.0</td><td><span style="color:blue">latest</span>, <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>
@@ -159,8 +105,7 @@ 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.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.7.0.0</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></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>
@@ -177,8 +122,7 @@ 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.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.5</td><td><span style="color:blue">latest</span>, <span style="color:green">recommended</span></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>
@@ -238,12 +182,12 @@ HLS bindists are experimental.
 
 Lower availability of bindists. Stack and HLS binaries are experimental.
 
-## Manual installation
+## Manual install
 
 Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
 and place it into your `PATH` anywhere.
 
-If you want to GPG verify the binaries, import the following keys first: `7784930957807690A66EBDBE3786C5262ECB4A3F` and `FE5AB6C91FEA597C3B31180B73EDE9E8CFBAEF01`.
+If you want to GPG verify the binaries, import the following key first: `7784930957807690A66EBDBE3786C5262ECB4A3F`.
 
 Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) like so:
 
@@ -255,20 +199,10 @@ export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
 
 See [ghcup.vim](https://github.com/hasufell/ghcup.vim).
 
-## VSCode integration
-The developers of the Haskell Language Server offer an [extension](https://github.com/haskell/vscode-haskell) tightly integrated with the [Haskell Language Server](https://github.com/haskell/haskell-language-server). To get started:
-
-1. Install GHCup. During installation, opt in to install the Haskell Language Server (HLS).
-2. Install the extension (from VSCode: Ctrl + P and then `ext install haskell.haskell`).
-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://github.com/haskell/ghcup-hs/issues/new)
+* [GHCup issue tracker](https://gitlab.haskell.org/haskell/ghcup-hs/issues)
 * [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/9.4.2/docs/users_guide/9.4.2-notes.html#included-libraries).
+[included with the GHC installation](https://downloads.haskell.org/ghc/latest/docs/html/users_guide/9.2.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 [Dmitrii Kovanikov](https://kodimensional.dev/))
+- A beginner friendly [4-lectures course](https://github.com/haskell-beginners-2022/course-plan) with exercises (by [Kowainik](https://kowainik.github.io/))
 - 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://github.com/haskell/ghcup-hs](https://github.com/haskell/ghcup-hs)
+* [https://gitlab.haskell.org/haskell/ghcup-hs](https://gitlab.haskell.org/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:      2.4
+cabal-version:      3.0
 name:               ghcup
-version:            0.1.18.1
+version:            0.1.18.0
 license:            LGPL-3.0-only
 license-file:       LICENSE
 copyright:          Julian Ospald 2020
 maintainer:         hasufell@posteo.de
 author:             Julian Ospald
-homepage:           https://github.com/haskell/ghcup-hs
-bug-reports:        https://github.com/haskell/ghcup-hs/issues/
+homepage:           https://gitlab.haskell.org/haskell/ghcup-hs
+bug-reports:        https://gitlab.haskell.org/haskell/ghcup-hs/issues
 synopsis:           ghc toolchain installer
 description:
   A rewrite of the shell script ghcup, for providing
@@ -21,18 +21,13 @@ extra-doc-files:
   README.md
 
 extra-source-files:
-  cbits/dirutils.c
-  cbits/dirutils.h
   data/build_mk/cross
   data/build_mk/default
-  test/golden/unix/GHCupInfo.json
-  test/golden/windows/GHCupInfo.json
-  test/data/file
-  test/data/dir/.keep
+  test/golden/GHCupInfo.json
 
 source-repository head
   type:     git
-  location: https://github.com/haskell/ghcup-hs.git
+  location: https://gitlab.haskell.org/haskell/ghcup-hs.git
 
 flag tui
   description:
@@ -49,40 +44,31 @@ flag internal-downloader
   manual:      True
 
 flag no-exe
-  description: Don't build any executables
+  description: Don't build any executables 
   default:     False
   manual:      True
 
 library
   exposed-modules:
     GHCup
-    GHCup.Cabal
     GHCup.Download
     GHCup.Download.Utils
     GHCup.Errors
-    GHCup.GHC
-    GHCup.HLS
-    GHCup.List
     GHCup.Platform
-    GHCup.Prelude
-    GHCup.Prelude.File
-    GHCup.Prelude.File.Search
-    GHCup.Prelude.Internal
-    GHCup.Prelude.Logger
-    GHCup.Prelude.Logger.Internal
-    GHCup.Prelude.MegaParsec
-    GHCup.Prelude.Process
-    GHCup.Prelude.String.QQ
-    GHCup.Prelude.Version.QQ
-    GHCup.Prompts
     GHCup.Requirements
-    GHCup.Stack
     GHCup.Types
     GHCup.Types.JSON
     GHCup.Types.JSON.Utils
     GHCup.Types.Optics
     GHCup.Utils
     GHCup.Utils.Dirs
+    GHCup.Utils.File
+    GHCup.Utils.File.Common
+    GHCup.Utils.Logger
+    GHCup.Utils.MegaParsec
+    GHCup.Utils.Prelude
+    GHCup.Utils.String.QQ
+    GHCup.Utils.Version.QQ
     GHCup.Version
 
   hs-source-dirs:     lib
@@ -114,8 +100,8 @@ library
     , base                  >=4.12       && <5
     , base16-bytestring     >=0.1.1.6    && <1.1
     , binary                ^>=0.8.6.0
-    , bytestring            >=0.10       && <0.12
-    , Cabal                 ^>=3.0.0.0 || ^>=3.2.0.0 || ^>=3.4.0.0 || ^>=3.6.0.0
+    , bytestring            ^>=0.10
+    , Cabal                 ^>=3.6.2.0
     , case-insensitive      ^>=1.2.1.0
     , casing                ^>=0.1.4.1
     , containers            ^>=0.6
@@ -123,7 +109,6 @@ library
     , deepseq               ^>=1.4.4.0
     , directory             ^>=1.3.6.0
     , disk-free-space       ^>=0.1.0.1
-    , exceptions            ^>=0.10
     , filepath              ^>=1.4.2.1
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  ^>=3.2.1
@@ -167,31 +152,26 @@ 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.Utils.File.Windows
+      GHCup.Utils.Prelude.Windows
+      GHCup.Utils.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.Posix
-      GHCup.Prelude.Process.Posix
-    exposed-modules:
-      GHCup.Prelude.File.Posix.Traversals
+      GHCup.Utils.File.Posix
+      GHCup.Utils.File.Posix.Foreign
+      GHCup.Utils.File.Posix.Traversals
+      GHCup.Utils.Posix
+      GHCup.Utils.Prelude.Posix
 
-    include-dirs:     cbits
-    includes:         dirutils.h
-    install-includes: dirutils.h
-    c-sources:        cbits/dirutils.c
+    c-sources:     cbits/dirutils.c
     build-depends:
       , bz2              >=0.5.0.5 && <1.1
       , terminal-size    ^>=0.3.2.1
@@ -219,7 +199,6 @@ executable ghcup
     GHCup.OptParse.Rm
     GHCup.OptParse.Run
     GHCup.OptParse.Set
-    GHCup.OptParse.Test
     GHCup.OptParse.ToolRequirements
     GHCup.OptParse.UnSet
     GHCup.OptParse.Upgrade
@@ -246,15 +225,13 @@ executable ghcup
     , aeson-pretty          ^>=0.8.8
     , async                 ^>=2.2.3
     , base                  >=4.12     && <5
-    , bytestring            >=0.10     && <0.12
+    , bytestring            ^>=0.10
     , 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
     , ghcup
-    , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
     , megaparsec            >=8.0.0    && <9.3
@@ -307,7 +284,6 @@ test-suite ghcup-test
     GHCup.ArbitraryTypes
     GHCup.Types.JSONSpec
     GHCup.Utils.FileSpec
-    GHCup.Prelude.File.Posix.TraversalsSpec
     Spec
 
   default-language:   Haskell2010
@@ -325,13 +301,13 @@ test-suite ghcup-test
 
   build-depends:
     , base                      >=4.12    && <5
-    , bytestring                >=0.10    && <0.12
+    , bytestring                ^>=0.10
     , 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
+    , generic-arbitrary         >=0.1.0   && <0.3
     , ghcup
-    , hspec                     >=2.7.10  && <2.11
+    , hspec                     >=2.7.10  && <2.10
     , hspec-golden-aeson        ^>=0.9
     , QuickCheck                ^>=2.14.1
     , quickcheck-arbitrary-adt  ^>=0.3.1.0
@@ -339,9 +315,3 @@ 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/Cabal.hs

@@ -1,285 +0,0 @@
-{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-
-{-|
-Module      : GHCup.Cabal
-Description : GHCup installation functions for Cabal
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : portable
--}
-module GHCup.Cabal where
-
-import           GHCup.Download
-import           GHCup.Errors
-import           GHCup.Types
-import           GHCup.Types.JSON               ( )
-import           GHCup.Types.Optics
-import           GHCup.Utils
-import           GHCup.Prelude
-import           GHCup.Prelude.File
-import           GHCup.Prelude.Logger
-
-import           Codec.Archive                  ( ArchiveResult )
-import           Control.Applicative
-import           Control.Exception.Safe
-import           Control.Monad
-#if !MIN_VERSION_base(4,13,0)
-import           Control.Monad.Fail             ( MonadFail )
-#endif
-import           Control.Monad.Reader
-import           Control.Monad.Trans.Resource
-                                         hiding ( throwM )
-import           Data.Either
-import           Data.List
-import           Data.Maybe
-import           Data.Versions                hiding ( patch )
-import           Haskus.Utils.Variant.Excepts
-import           Optics
-import           Prelude                 hiding ( abs
-                                                , writeFile
-                                                )
-import           Safe                    hiding ( at )
-import           System.FilePath
-import           System.IO.Error
-
-import qualified Data.Text                     as T
-
-
-
-    -------------------------
-    --[ Tool installation ]--
-    -------------------------
-
-
--- | Like 'installCabalBin', except takes the 'DownloadInfo' as
--- argument instead of looking it up from 'GHCupDownloads'.
-installCabalBindist :: ( MonadMask m
-                       , MonadCatch m
-                       , MonadReader env m
-                       , HasPlatformReq env
-                       , HasDirs env
-                       , HasSettings env
-                       , HasLog env
-                       , MonadResource m
-                       , MonadIO m
-                       , MonadUnliftIO m
-                       , MonadFail m
-                       )
-                    => DownloadInfo
-                    -> Version
-                    -> InstallDir
-                    -> Bool           -- ^ Force install
-                    -> Excepts
-                         '[ AlreadyInstalled
-                          , CopyError
-                          , DigestError
-                          , ContentLengthError
-                          , GPGError
-                          , DownloadFailed
-                          , NoDownload
-                          , NotInstalled
-                          , UnknownArchive
-                          , TarDirDoesNotExist
-                          , ArchiveResult
-                          , FileAlreadyExistsError
-                          ]
-                         m
-                         ()
-installCabalBindist dlinfo ver installDir forceInstall = do
-  lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver
-
-  PlatformRequest {..} <- lift getPlatformReq
-  Dirs {..} <- lift getDirs
-
-  -- check if we already have a regular cabal already installed
-  regularCabalInstalled <- lift $ cabalInstalled ver
-
-  if
-    | not forceInstall
-    , regularCabalInstalled
-    , GHCupInternal <- installDir -> do
-        throwE $ AlreadyInstalled Cabal ver
-
-    | forceInstall
-    , regularCabalInstalled
-    , GHCupInternal <- installDir -> do
-        lift $ logInfo "Removing the currently installed version first!"
-        liftE $ rmCabalVer ver
-
-    | otherwise -> pure ()
-
-
-  -- download (or use cached version)
-  dl <- liftE $ downloadCached dlinfo Nothing
-
-  -- unpack
-  tmpUnpack <- lift withGHCupTmpDir
-  liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
-  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
-
-  -- the subdir of the archive where we do the work
-  workdir <- fromGHCupPath <$> maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
-
-  case installDir of
-    IsolateDir isoDir -> do             -- isolated install
-      lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir
-      liftE $ installCabalUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
-
-    GHCupInternal -> do                 -- regular install
-      liftE $ installCabalUnpacked workdir (GHCupBinDir binDir) ver forceInstall
-
-
--- | Install an unpacked cabal distribution.Symbol
-installCabalUnpacked :: (MonadCatch m, HasLog env, MonadIO m, MonadReader env m)
-              => FilePath      -- ^ Path to the unpacked cabal bindist (where the executable resides)
-              -> InstallDirResolved      -- ^ Path to install to
-              -> Version
-              -> Bool          -- ^ Force Install
-              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
-installCabalUnpacked path inst ver forceInstall = do
-  lift $ logInfo "Installing cabal"
-  let cabalFile = "cabal"
-  liftIO $ createDirRecursive' (fromInstallDir inst)
-  let destFileName = cabalFile
-        <> (case inst of
-              IsolateDirResolved _ -> ""
-              _ -> ("-" <>) . T.unpack . prettyVer $ ver
-           )
-        <> exeExt
-  let destPath = fromInstallDir inst </> destFileName
-
-  copyFileE
-    (path </> cabalFile <> exeExt)
-    destPath
-    (not forceInstall)
-  lift $ chmod_755 destPath
-
--- | Installs cabal into @~\/.ghcup\/bin/cabal-\<ver\>@ and
--- creates a default @cabal -> cabal-x.y.z.q@ symlink for
--- the latest installed version.
-installCabalBin :: ( MonadMask m
-                   , MonadCatch m
-                   , MonadReader env m
-                   , HasPlatformReq env
-                   , HasGHCupInfo env
-                   , HasDirs env
-                   , HasSettings env
-                   , HasLog env
-                   , MonadResource m
-                   , MonadIO m
-                   , MonadUnliftIO m
-                   , MonadFail m
-                   )
-                => Version
-                -> InstallDir
-                -> Bool           -- force install
-                -> Excepts
-                     '[ AlreadyInstalled
-                      , CopyError
-                      , DigestError
-                      , ContentLengthError
-                      , GPGError
-                      , DownloadFailed
-                      , NoDownload
-                      , NotInstalled
-                      , UnknownArchive
-                      , TarDirDoesNotExist
-                      , ArchiveResult
-                      , FileAlreadyExistsError
-                      ]
-                     m
-                     ()
-installCabalBin ver installDir forceInstall = do
-  dlinfo <- liftE $ getDownloadInfo Cabal ver
-  installCabalBindist dlinfo ver installDir forceInstall
-
-
-    -----------------
-    --[ Set cabal ]--
-    -----------------
-
-
--- | Set the @~\/.ghcup\/bin\/cabal@ symlink.
-setCabal :: ( MonadMask m
-            , MonadReader env m
-            , HasDirs env
-            , HasLog env
-            , MonadFail m
-            , MonadIO m
-            , MonadUnliftIO m)
-         => Version
-         -> Excepts '[NotInstalled] m ()
-setCabal ver = do
-  let targetFile = "cabal-" <> T.unpack (prettyVer ver) <> exeExt
-
-  -- symlink destination
-  Dirs {..} <- lift getDirs
-
-  whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
-    $ throwE
-    $ NotInstalled Cabal (GHCTargetVersion Nothing ver)
-
-  let cabalbin = binDir </> "cabal" <> exeExt
-
-  -- create link
-  let destL = targetFile
-  lift $ createLink destL cabalbin
-
-  liftIO (isShadowed cabalbin) >>= \case
-    Nothing -> pure ()
-    Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa cabalbin ver)
-
-  pure ()
-
-unsetCabal :: ( MonadMask m
-              , MonadReader env m
-              , HasDirs env
-              , MonadIO m)
-           => m ()
-unsetCabal = do
-  Dirs {..} <- getDirs
-  let cabalbin = binDir </> "cabal" <> exeExt
-  hideError doesNotExistErrorType $ rmLink cabalbin
-
-
-    ----------------
-    --[ Rm cabal ]--
-    ----------------
-
-
--- | Delete a cabal version. Will try to fix the @cabal@ symlink
--- after removal (e.g. setting it to an older version).
-rmCabalVer :: ( MonadMask m
-              , MonadReader env m
-              , HasDirs env
-              , MonadThrow m
-              , HasLog env
-              , MonadIO m
-              , MonadFail m
-              , MonadCatch m
-              , MonadUnliftIO m
-              )
-           => Version
-           -> Excepts '[NotInstalled] m ()
-rmCabalVer ver = do
-  whenM (lift $ fmap not $ cabalInstalled ver) $ throwE (NotInstalled Cabal (GHCTargetVersion Nothing ver))
-
-  cSet      <- lift cabalSet
-
-  Dirs {..} <- lift getDirs
-
-  let cabalFile = "cabal-" <> T.unpack (prettyVer ver) <> exeExt
-  lift $ hideError doesNotExistErrorType $ recycleFile (binDir </> cabalFile)
-
-  when (Just ver == cSet) $ do
-    cVers <- lift $ fmap rights getInstalledCabals
-    case headMay . reverse . sort $ cVers of
-      Just latestver -> setCabal latestver
-      Nothing        -> lift $ rmLink (binDir </> "cabal" <> exeExt)

lib/GHCup/Download.hs

@@ -34,10 +34,9 @@ import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
-import           GHCup.Prelude
-import           GHCup.Prelude.File
-import           GHCup.Prelude.Logger.Internal
-import           GHCup.Prelude.Process
+import           GHCup.Utils.File
+import           GHCup.Utils.Logger
+import           GHCup.Utils.Prelude
 import           GHCup.Version
 
 import           Control.Applicative
@@ -75,6 +74,7 @@ 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
@@ -113,7 +113,7 @@ getDownloadsF :: ( FromJSONKey Tool
                  , MonadMask m
                  )
               => Excepts
-                   '[DigestError, ContentLengthError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
+                   '[DigestError, GPGError, JSONError , DownloadFailed , FileDoesNotExistError]
                    m
                    GHCupInfo
 getDownloadsF = do
@@ -161,21 +161,17 @@ getBase :: ( MonadReader env m
            , MonadMask m
            )
         => URI
-        -> Excepts '[DownloadFailed, GPGError, DigestError, ContentLengthError, JSONError, FileDoesNotExistError] m GHCupInfo
+        -> Excepts '[GPGError, DigestError, JSONError, FileDoesNotExistError] m GHCupInfo
 getBase uri = do
-  Settings { noNetwork, downloader, metaMode } <- lift getSettings
+  Settings { noNetwork, downloader } <- 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 -> 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)
+           else handleIO (\e -> lift (warnCache (displayException e) downloader) >> pure Nothing)
+               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> lift (warnCache (prettyShow e) downloader) >> pure Nothing)
                . fmap Just
                . smartDl
                $ uri
@@ -187,7 +183,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
@@ -232,7 +228,6 @@ getBase uri = do
           -> Excepts
                '[ DownloadFailed
                 , DigestError
-                , ContentLengthError
                 , GPGError
                 ]
                m1
@@ -246,7 +241,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 Nothing (fromGHCupPath cacheDir) Nothing True
+    if | scheme == "file" -> liftE $ download uri' Nothing Nothing (fromGHCupPath cacheDir) Nothing True
        | e -> do
           accessTime <- fmap utcTimeToPOSIXSeconds $ liftIO $ getAccessTime json_file
           let sinceLastAccess = utcTimeToPOSIXSeconds currentTime - accessTime
@@ -262,7 +257,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 Nothing dir (Just fn) True
+      f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing dir (Just fn) True
       liftIO $ setModificationTime f modTime
       liftIO $ setAccessTime f modTime
       pure f
@@ -328,14 +323,13 @@ 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, ContentLengthError, DownloadFailed, GPGError] m FilePath
-download uri gpgUri eDigest eCSize dest mfn etags
-  | scheme == "https" = liftE dl
-  | scheme == "http"  = liftE dl
+         -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
+download uri gpgUri eDigest dest mfn etags
+  | scheme == "https" = dl
+  | scheme == "http"  = dl
   | scheme == "file"  = do
       let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
       lift $ logDebug $ "using local file: " <> T.pack destFile'
@@ -356,7 +350,7 @@ download uri gpgUri eDigest eCSize dest mfn etags
     -- download
     flip onException
          (lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile))
-     $ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError, ContentLengthError] @'[DigestError, ContentLengthError, DownloadFailed, GPGError]
+     $ catchAllE @_ @'[GPGError, ProcessError, DownloadFailed, UnsupportedScheme, DigestError] @'[DigestError, DownloadFailed, GPGError]
           (\e' -> do
             lift $ hideError doesNotExistErrorType $ recycleFile (tmpFile baseDestFile)
             case e' of
@@ -391,7 +385,7 @@ download uri gpgUri eDigest eCSize 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 (prettyHFError (GPGError e))
+                        (\e -> if gpgSetting == GPGStrict then throwE (GPGError e) else lift $ logWarn $ T.pack (prettyShow (GPGError e))
                         ) $ do
                       o' <- liftIO getGpgOpts
                       lift $ logDebug $ "downloading: " <> (decUTF8Safe . serializeURIRef') gpgUri' <> " as file " <> T.pack gpgDestFile
@@ -406,37 +400,19 @@ download uri gpgUri eDigest eCSize 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']
-            ++ maybe [] (\s -> ["--max-filesize", show s]) eCSize
-        ) Nothing Nothing
+        (o' ++ ["-fL", "-o", destFileTemp, T.unpack uri']) 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"
@@ -463,14 +439,7 @@ download uri gpgUri eDigest eCSize 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
@@ -479,16 +448,8 @@ download uri gpgUri eDigest eCSize 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
@@ -509,10 +470,7 @@ download uri gpgUri eDigest eCSize 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
@@ -522,16 +480,11 @@ download uri gpgUri eDigest eCSize dest mfn etags
                  @'[DownloadFailed]
             (\e@(HTTPNotModified _) ->
               throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
-        $ downloadToFile https host fullPath port destFileTemp mempty eCSize
+        $ downloadToFile https host fullPath port destFileTemp mempty
       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
@@ -543,7 +496,7 @@ download uri gpgUri eDigest eCSize dest mfn etags
       liftE
         $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
         $ do
-          r <- downloadToFile https host fullPath port destFileTemp addHeaders eCSize
+          r <- downloadToFile https host fullPath port destFileTemp addHeaders
           liftIO $ renameFile destFileTemp destFile
           lift $ writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
 #endif
@@ -551,7 +504,7 @@ download uri gpgUri eDigest eCSize 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)
@@ -620,14 +573,14 @@ downloadCached :: ( MonadReader env m
                   )
                => DownloadInfo
                -> Maybe FilePath  -- ^ optional filename
-               -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
+               -> Excepts '[DigestError , 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)) (_dlCSize dli) (fromGHCupPath tmp) mfn False
+      liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) (fromGHCupPath tmp) mfn False
 
 
 downloadCached' :: ( MonadReader env m
@@ -642,7 +595,7 @@ downloadCached' :: ( MonadReader env m
                 => DownloadInfo
                 -> Maybe FilePath  -- ^ optional filename
                 -> Maybe FilePath  -- ^ optional destination dir (default: cacheDir)
-                -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
+                -> Excepts '[DigestError , DownloadFailed, GPGError] m FilePath
 downloadCached' dli mfn mDestDir = do
   Dirs { cacheDir } <- lift getDirs
   let destDir = fromMaybe (fromGHCupPath cacheDir) mDestDir
@@ -651,10 +604,9 @@ 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)) (_dlCSize dli) destDir mfn False
+    | otherwise -> liftE $ download (_dlUri dli) Nothing (Just (_dlHash dli)) destDir mfn False
 
 
 
@@ -685,25 +637,6 @@ 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

@@ -10,19 +10,21 @@ module GHCup.Download.IOStreams where
 import           GHCup.Download.Utils
 import           GHCup.Errors
 import           GHCup.Types.JSON               ( )
-import           GHCup.Prelude
+import           GHCup.Utils.Prelude
 
 import           Control.Applicative
 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
@@ -31,6 +33,7 @@ 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
 
@@ -43,6 +46,27 @@ 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?
@@ -51,9 +75,8 @@ 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 eCSize = do
+downloadToFile https host fullPath port destFile addHeaders = do
   let stepper = BS.appendFile destFile
       setup = BS.writeFile destFile mempty
   catchAllE (\case
@@ -61,7 +84,7 @@ downloadToFile https host fullPath port destFile addHeaders eCSize = 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 eCSize
+            ) $ downloadInternal True https host fullPath port stepper setup addHeaders
 
 
 downloadInternal :: MonadIO m
@@ -73,21 +96,19 @@ 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 eCSize = do
+  go redirs progressBar https host path port consumer setup addHeaders = do
     r <- liftIO $ withConnection' https host port action
     veitherToExcepts r >>= \case
       Right r' ->
@@ -117,39 +138,25 @@ 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 eCSize
+        go (redirs - 1) progressBar https' host' fullPath' port' consumer setup addHeaders
       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  _       -> Nothing
-              Right (r', _) -> Just r'
-            Nothing -> Nothing
+              Left  _       -> 0
+              Right (r', _) -> r'
+            Nothing -> 0
 
-      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
+      (mpb :: Maybe (ProgressBar ())) <- if progressBar
+        then Just <$> newProgressBar defStyle 10 (Progress 0 size ())
+        else pure Nothing
 
       outStream <- liftIO $ Streams.makeOutputStream
         (\case
           Just bs -> do
-            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)
-
+            forM_ mpb $ \pb -> incProgress pb (BS.length bs)
             void $ consumer bs
           Nothing -> pure ()
         )

lib/GHCup/Download/Utils.hs

@@ -10,7 +10,7 @@ module GHCup.Download.Utils where
 import           GHCup.Errors
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
-import           GHCup.Prelude
+import           GHCup.Utils.Prelude
 
 import           Control.Applicative
 import           Control.Monad

lib/GHCup/Errors.hs

@@ -6,7 +6,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeOperators           #-}
 {-# LANGUAGE FlexibleInstances           #-}
-{-# LANGUAGE RankNTypes           #-}
 
 {-|
 Module      : GHCup.Errors
@@ -35,153 +34,9 @@ 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 (4000+)"
-    , let proxy = Proxy :: Proxy DownloadFailed in format proxy
-    , let proxy = Proxy :: Proxy InstallSetError in format proxy
-    , let proxy = Proxy :: Proxy TestFailed 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
-  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
-
-linkEscapeCode :: String -> String -> String
-linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
-
-
     ------------------------
     --[ Low-level errors ]--
     ------------------------
@@ -196,32 +51,20 @@ 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 (eDesc (Proxy :: Proxy NoDownload))
-
-instance HFErrorProject NoDownload where
-  eBase _ = 10
-  eDesc _ = "Unable to find a download for the requested version/distro."
+    text "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 (eDesc (Proxy :: Proxy NoUpdate))
-
-instance HFErrorProject NoUpdate where
-  eBase _ = 20
-  eDesc _ = "No update available or necessary."
+  pPrint NoUpdate = text "No update available or necessary."
 
 -- | The Architecture is unknown and unsupported.
 data NoCompatibleArch = NoCompatibleArch String
@@ -231,21 +74,13 @@ 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 (eDesc (Proxy :: Proxy DistroNotFound))
-
-instance HFErrorProject DistroNotFound where
-  eBase _ = 40
-  eDesc _ = "Unable to figure out the distribution of the host"
+    text "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
@@ -255,21 +90,12 @@ 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 (eDesc (Proxy :: Proxy UnsupportedScheme))
-
-instance HFErrorProject UnsupportedScheme where
-  eBase _ = 60
-  eDesc _ = "The scheme is not supported (such as ftp)."
+  pPrint UnsupportedScheme = text "The scheme is not supported (such as ftp)."
 
 -- | Unable to copy a file.
 data CopyError = CopyError String
@@ -279,23 +105,6 @@ 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
-
-instance Pretty MergeFileTreeError where
-  pPrint (MergeFileTreeError e from to) =
-    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
@@ -304,10 +113,6 @@ 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
@@ -317,35 +122,21 @@ 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
 
 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" <+> 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"
+    pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed"
 
 -- | The Directory is supposed to be empty, but wasn't.
 data DirNotEmpty = DirNotEmpty {path :: FilePath}
-  deriving Show
 
 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
@@ -355,10 +146,6 @@ 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
 
@@ -366,10 +153,6 @@ 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
@@ -380,10 +163,6 @@ 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
@@ -392,10 +171,6 @@ 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
@@ -405,10 +180,6 @@ 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)
@@ -419,10 +190,6 @@ 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
 
@@ -430,10 +197,6 @@ 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
@@ -444,11 +207,7 @@ 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."
 
-instance HFErrorProject DigestError where
-  eBase _ = 200
-  eDesc _ = "File digest verification failed"
-
--- | File PGP verification failed.
+-- | File digest 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
@@ -456,10 +215,6 @@ 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
@@ -468,10 +223,6 @@ 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
@@ -480,10 +231,6 @@ 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
@@ -492,21 +239,13 @@ 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 (eDesc (Proxy :: Proxy NoLocationHeader))
-
-instance HFErrorProject NoLocationHeader where
-  eBase _ = 250
-  eDesc _ = "The 'Location' header was expected during a 3xx redirect, but not found."
+    text "The 'Location' header was expected during a 3xx redirect, but not found."
 
 -- | Too many redirects.
 data TooManyRedirs = TooManyRedirs
@@ -514,11 +253,7 @@ data TooManyRedirs = TooManyRedirs
 
 instance Pretty TooManyRedirs where
   pPrint TooManyRedirs =
-    text (eDesc (Proxy :: Proxy TooManyRedirs))
-
-instance HFErrorProject TooManyRedirs where
-  eBase _ = 260
-  eDesc _ = "Too many redirections."
+    text "Too many redirections."
 
 -- | A patch could not be applied.
 data PatchFailed = PatchFailed
@@ -526,11 +261,7 @@ data PatchFailed = PatchFailed
 
 instance Pretty PatchFailed where
   pPrint PatchFailed =
-    text (eDesc (Proxy :: Proxy PatchFailed))
-
-instance HFErrorProject PatchFailed where
-  eBase _ = 270
-  eDesc _ = "A patch could not be applied."
+    text "A patch could not be applied."
 
 -- | The tool requirements could not be found.
 data NoToolRequirements = NoToolRequirements
@@ -538,11 +269,7 @@ data NoToolRequirements = NoToolRequirements
 
 instance Pretty NoToolRequirements where
   pPrint NoToolRequirements =
-    text (eDesc (Proxy :: Proxy NoToolRequirements))
-
-instance HFErrorProject NoToolRequirements where
-  eBase _ = 280
-  eDesc _ = "The Tool requirements could not be found."
+    text "The Tool requirements could not be found."
 
 data InvalidBuildConfig = InvalidBuildConfig Text
   deriving Show
@@ -551,10 +278,6 @@ 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
 
@@ -562,90 +285,45 @@ 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 (eDesc (Proxy :: Proxy NoNetwork))
-
-instance HFErrorProject NoNetwork where
-  eBase _ = 310
-  eDesc _ = "A download was required or requested, but '--offline' was specified."
+    text "A download was required or requested, but '--offline' was specified."
 
 data HadrianNotFound = HadrianNotFound
   deriving Show
 
 instance Pretty HadrianNotFound where
   pPrint HadrianNotFound =
-    text (eDesc (Proxy :: Proxy HadrianNotFound))
+    text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
 
-instance HFErrorProject HadrianNotFound where
-  eBase _ = 320
-  eDesc _ = "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
-
-data ToolShadowed = ToolShadowed
-                       Tool
+data GHCupShadowed = GHCupShadowed
                        FilePath  -- shadow binary
                        FilePath  -- upgraded binary
                        Version   -- upgraded version
   deriving Show
 
-instance Pretty ToolShadowed where
-  pPrint (ToolShadowed tool sh up _) =
-    text (prettyShow tool
-         <> " is shadowed by "
+instance Pretty GHCupShadowed where
+  pPrint (GHCupShadowed sh up _) =
+    text ("ghcup is shadowed by "
          <> sh
-         <> ".\nThe upgrade will not be in effect, unless you remove "
+         <> ". The upgrade will not be in effect, unless you remove "
          <> sh
-         <> "\nor make sure "
+         <> " or make sure "
          <> takeDirectory up
          <> " comes before "
          <> takeDirectory sh
          <> " 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 . (HFErrorProject (V xs), ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
+data DownloadFailed = forall xs . (ToVariantMaybe DownloadFailed xs, PopVariant DownloadFailed xs, Show (V xs), Pretty (V xs)) => DownloadFailed (V xs)
 
 instance Pretty DownloadFailed where
   pPrint (DownloadFailed reason) =
@@ -655,47 +333,9 @@ instance Pretty DownloadFailed where
 
 deriving instance Show DownloadFailed
 
-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) =
-     text "Both installation and setting the tool failed. Install error was:"
-      <+> pPrint reason1
-      <+> text "\nSet error was:"
-      <+> pPrint reason2
-
-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 test failed.
-data TestFailed = forall es . (ToVariantMaybe TestFailed es, PopVariant TestFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => TestFailed FilePath (V es)
-
-instance Pretty TestFailed where
-  pPrint (TestFailed path reason) =
-    case reason of
-      VMaybe (_ :: TestFailed) -> pPrint reason
-      _ -> text ("The test failed. GHC test suite is fragile and non-portable. Please also check out the " <> linkEscapeCode "issue tracker" " https://gitlab.haskell.org/ghc/ghc/-/issues/?sort=updated_desc&state=opened&label_name%5B%5D=testsuite&label_name%5B%5D=packaging&first_page_size=20" <> ".\nBuild dir was:") <+> text path <+> text "\nReason was:" <+> pPrint reason
-
-deriving instance Show TestFailed
-
-instance HFErrorProject TestFailed where
-  eBase _ = 4000
-  eNum (TestFailed _ xs2) = 4000 + eNum xs2
-  eDesc _ = "The test failed."
 
 -- | A build failed.
-data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => BuildFailed FilePath (V es)
+data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es)) => BuildFailed FilePath (V es)
 
 instance Pretty BuildFailed where
   pPrint (BuildFailed path reason) =
@@ -705,28 +345,18 @@ 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), HFErrorProject (V es)) => GHCupSetError (V es)
+data GHCupSetError = forall es . (ToVariantMaybe GHCupSetError es, PopVariant GHCupSetError es, Show (V es), Pretty (V es)) => GHCupSetError (V es)
 
 instance Pretty GHCupSetError where
   pPrint (GHCupSetError reason) =
     case reason of
       VMaybe (_ :: GHCupSetError) -> pPrint reason
-      _ -> text "Setting the current version failed:" <+> pPrint reason
+      _ -> text "Setting the current GHC 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) ]--
@@ -743,10 +373,6 @@ instance Pretty ParseError where
 
 instance Exception ParseError
 
-instance HFErrorProject ParseError where
-  eBase _ = 500
-  eDesc _ = "A parse error occured."
-
 
 data UnexpectedListLength = UnexpectedListLength String
   deriving Show
@@ -757,10 +383,6 @@ 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
 
@@ -770,10 +392,6 @@ instance Pretty NoUrlBase where
 
 instance Exception NoUrlBase
 
-instance HFErrorProject NoUrlBase where
-  eBase _ = 520
-  eDesc _ = "URL does not have a base filename."
-
 
 
     ------------------------
@@ -793,23 +411,6 @@ 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)
@@ -828,22 +429,6 @@ 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"
@@ -852,37 +437,5 @@ 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/HLS.hs

@@ -1,725 +0,0 @@
-{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE BangPatterns          #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE QuasiQuotes           #-}
-
-{-|
-Module      : GHCup.HLS
-Description : GHCup installation functions for HLS
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : portable
--}
-module GHCup.HLS where
-
-import           GHCup.Download
-import           GHCup.Errors
-import           GHCup.Types
-import           GHCup.Types.JSON               ( )
-import           GHCup.Types.Optics
-import           GHCup.Utils
-import           GHCup.Prelude
-import           GHCup.Prelude.File
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.Process
-import           GHCup.Prelude.String.QQ
-
-import           Codec.Archive                  ( ArchiveResult )
-import           Control.Applicative
-import           Control.Exception.Safe
-import           Control.Monad
-#if !MIN_VERSION_base(4,13,0)
-import           Control.Monad.Fail             ( MonadFail )
-#endif
-import           Control.Monad.Reader
-import           Control.Monad.Trans.Resource
-                                         hiding ( throwM )
-import           Data.ByteString                ( ByteString )
-import           Data.Either
-import           Data.List
-import           Data.Maybe
-import           Data.String                    ( fromString )
-import           Data.Text                      ( Text )
-import           Data.Versions                hiding ( patch )
-import           Distribution.Types.Version   hiding ( Version )
-import           Distribution.Types.PackageId
-import           Distribution.Types.PackageDescription
-import           Distribution.Types.GenericPackageDescription
-import           Distribution.PackageDescription.Parsec
-import           GHC.IO.Exception
-import           Haskus.Utils.Variant.Excepts
-import           Optics
-import           Prelude                 hiding ( abs
-                                                , writeFile
-                                                )
-import           Safe                    hiding ( at )
-import           System.FilePath
-import           System.IO.Error
-import           Text.Regex.Posix
-import           URI.ByteString
-
-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
-
-
-data HLSVer = SourceDist Version
-            | GitDist GitBranch
-            | HackageDist Version
-            | RemoteDist URI
-
-
-
-    --------------------
-    --[ Installation ]--
-    --------------------
-
-
--- | Like 'installHLSBin, except takes the 'DownloadInfo' as
--- argument instead of looking it up from 'GHCupDownloads'.
-installHLSBindist :: ( MonadMask m
-                     , MonadCatch m
-                     , MonadReader env m
-                     , HasPlatformReq env
-                     , HasDirs env
-                     , HasSettings env
-                     , HasLog env
-                     , MonadResource m
-                     , MonadIO m
-                     , MonadUnliftIO m
-                     , MonadFail m
-                     )
-                  => DownloadInfo
-                  -> Version
-                  -> InstallDir -- ^ isolated install path, if user passed any
-                  -> Bool       -- ^ Force install
-                  -> Excepts
-                       '[ AlreadyInstalled
-                        , CopyError
-                        , DigestError
-                        , ContentLengthError
-                        , GPGError
-                        , DownloadFailed
-                        , NoDownload
-                        , NotInstalled
-                        , UnknownArchive
-                        , TarDirDoesNotExist
-                        , ArchiveResult
-                        , FileAlreadyExistsError
-                        , ProcessError
-                        , DirNotEmpty
-                        , UninstallFailed
-                        , MergeFileTreeError
-                        ]
-                       m
-                       ()
-installHLSBindist dlinfo ver installDir forceInstall = do
-  lift $ logDebug $ "Requested to install hls version " <> prettyVer ver
-
-  PlatformRequest {..} <- lift getPlatformReq
-  Dirs {..} <- lift getDirs
-
-  regularHLSInstalled <- lift $ hlsInstalled ver
-
-  if
-    | not forceInstall
-    , regularHLSInstalled
-    , GHCupInternal <- installDir -> do        -- regular install
-        throwE $ AlreadyInstalled HLS ver
-
-    | forceInstall
-    , regularHLSInstalled
-    , GHCupInternal <- installDir -> do        -- regular forced install
-        lift $ logInfo "Removing the currently installed version of HLS before force installing!"
-        liftE $ rmHLSVer ver
-
-    | otherwise -> pure ()
-
-  -- download (or use cached version)
-  dl <- liftE $ downloadCached dlinfo Nothing
-
-  -- unpack
-  tmpUnpack <- lift withGHCupTmpDir
-  liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
-  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
-
-  -- the subdir of the archive where we do the work
-  workdir <- fromGHCupPath <$> maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
-  legacy <- liftIO $ isLegacyHLSBindist workdir
-
-  if
-    | not forceInstall
-    , not legacy
-    , (IsolateDir fp) <- installDir -> liftE $ installDestSanityCheck (IsolateDirResolved fp)
-    | otherwise -> pure ()
-
-  case installDir of
-    IsolateDir isoDir -> do
-      lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
-      if legacy
-      then liftE $ installHLSUnpackedLegacy workdir (IsolateDirResolved isoDir) ver forceInstall
-      else liftE $ runBuildAction tmpUnpack $ installHLSUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
-
-    GHCupInternal -> do
-      if legacy
-      then liftE $ installHLSUnpackedLegacy workdir (GHCupBinDir binDir) ver forceInstall
-      else do
-        inst <- ghcupHLSDir ver
-        liftE $ runBuildAction tmpUnpack
-              $ installHLSUnpacked workdir (GHCupDir inst) ver forceInstall
-        liftE $ setHLS ver SetHLS_XYZ Nothing
-
-
-isLegacyHLSBindist :: FilePath -- ^ Path to the unpacked hls bindist
-                   -> IO Bool
-isLegacyHLSBindist path = do
-  not <$> doesFileExist (path </> "GNUmakefile")
-
--- | Install an unpacked hls distribution.
-installHLSUnpacked :: ( MonadMask m
-                      , MonadUnliftIO m
-                      , MonadReader env m
-                      , MonadFail m
-                      , HasLog env
-                      , HasDirs env
-                      , HasSettings env
-                      , MonadCatch m
-                      , MonadIO m
-                      , MonadResource m
-                      , HasPlatformReq env
-                      )
-                   => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
-                   -> InstallDirResolved      -- ^ Path to install to
-                   -> Version
-                   -> Bool
-                   -> Excepts '[ProcessError, CopyError, FileAlreadyExistsError, NotInstalled, MergeFileTreeError] m ()
-installHLSUnpacked path inst ver forceInstall = do
-  PlatformRequest { .. } <- lift getPlatformReq
-  lift $ logInfo "Installing HLS"
-  tmpInstallDest <- lift withGHCupTmpDir
-  lEM $ make ["DESTDIR=" <> fromGHCupPath tmpInstallDest, "PREFIX=" <> fromInstallDir inst, "install"] (Just path)
-  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpInstallDest)
-  liftE $ mergeFileTree (tmpInstallDest `appendGHCupPath` dropDrive (fromInstallDir inst))
-                   inst
-                   HLS
-                   (mkTVer ver)
-                   (\f t -> liftIO $ do
-                       mtime <- ifM (pathIsSymbolicLink f) (pure Nothing) (Just <$> getModificationTime f)
-                       install f t (not forceInstall)
-                       forM_ mtime $ setModificationTime t)
-
--- | Install an unpacked hls distribution (legacy).
-installHLSUnpackedLegacy :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
-                         => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
-                         -> InstallDirResolved      -- ^ Path to install to
-                         -> Version
-                         -> Bool          -- ^ is it a force install
-                         -> Excepts '[CopyError, FileAlreadyExistsError] m ()
-installHLSUnpackedLegacy path installDir ver forceInstall = do
-  lift $ logInfo "Installing HLS"
-  liftIO $ createDirRecursive' (fromInstallDir installDir)
-
-  -- install haskell-language-server-<ghcver>
-  bins@(_:_) <- liftIO $ findFiles
-    path
-    (makeRegexOpts compExtended
-                   execBlank
-                   ([s|^haskell-language-server-[0-9].*$|] :: ByteString)
-    )
-  forM_ bins $ \f -> do
-    let toF = dropSuffix exeExt f
-              <> (case installDir of
-                   IsolateDirResolved _ -> ""
-                   _ -> ("~" <>) . T.unpack . prettyVer $ ver
-                 )
-              <> exeExt
-
-    let srcPath = path </> f
-    let destPath = fromInstallDir installDir </> toF
-
-    -- destination could be an existing symlink
-    -- for new make-based HLSes
-    liftIO $ rmFileForce destPath
-
-    copyFileE
-      srcPath
-      destPath
-      (not forceInstall)
-    lift $ chmod_755 destPath
-
-  -- install haskell-language-server-wrapper
-  let wrapper = "haskell-language-server-wrapper"
-      toF = wrapper
-            <> (case installDir of
-                 IsolateDirResolved _ -> ""
-                 _ -> ("-" <>) . T.unpack . prettyVer $ ver
-               )
-            <> exeExt
-      srcWrapperPath = path </> wrapper <> exeExt
-      destWrapperPath = fromInstallDir installDir </> toF
-
-  liftIO $ rmFileForce destWrapperPath
-  copyFileE
-    srcWrapperPath
-    destWrapperPath
-    (not forceInstall)
-
-  lift $ chmod_755 destWrapperPath
-
-
-
--- | Installs hls binaries @haskell-language-server-\<ghcver\>@
--- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
-installHLSBin :: ( MonadMask m
-                 , MonadCatch m
-                 , MonadReader env m
-                 , HasPlatformReq env
-                 , HasGHCupInfo env
-                 , HasDirs env
-                 , HasSettings env
-                 , HasLog env
-                 , MonadResource m
-                 , MonadIO m
-                 , MonadUnliftIO m
-                 , MonadFail m
-                 )
-              => Version
-              -> InstallDir
-              -> Bool            -- force install
-              -> Excepts
-                   '[ AlreadyInstalled
-                    , CopyError
-                    , DigestError
-                    , ContentLengthError
-                    , GPGError
-                    , DownloadFailed
-                    , NoDownload
-                    , NotInstalled
-                    , UnknownArchive
-                    , TarDirDoesNotExist
-                    , ArchiveResult
-                    , FileAlreadyExistsError
-                    , ProcessError
-                    , DirNotEmpty
-                    , UninstallFailed
-                    , MergeFileTreeError
-                    ]
-                   m
-                   ()
-installHLSBin ver installDir forceInstall = do
-  dlinfo <- liftE $ getDownloadInfo HLS ver
-  installHLSBindist dlinfo ver installDir forceInstall
-
-
-compileHLS :: ( MonadMask m
-              , MonadCatch m
-              , MonadReader env m
-              , HasDirs env
-              , HasSettings env
-              , HasPlatformReq env
-              , HasGHCupInfo env
-              , HasLog env
-              , MonadResource m
-              , MonadIO m
-              , MonadUnliftIO m
-              , MonadFail m
-              )
-           => 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 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, tmpUnpack, tver, git_describe) <- case targetHLS of
-    -- unpack from version tarball
-    SourceDist tver -> do
-      lift $ logDebug $ "Requested to compile: " <> prettyVer tver
-
-      -- download source tarball
-      dlInfo <-
-        preview (ix HLS % ix tver % viSourceDL % _Just) dls
-          ?? NoDownload
-      dl <- liftE $ downloadCached dlInfo Nothing
-
-      -- unpack
-      tmpUnpack <- lift mkGhcupTmpDir
-      liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
-      liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
-
-      workdir <- maybe (pure tmpUnpack)
-                       (liftE . intoSubdir tmpUnpack)
-                       (view dlSubdir dlInfo)
-
-      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
-    GitDist GitBranch{..} -> do
-      tmpUnpack <- lift mkGhcupTmpDir
-      let git args = execLogged "git" ("--no-pager":args) (Just $ fromGHCupPath tmpUnpack) "git" Nothing
-      reThrowAll @_ @'[ProcessError] DownloadFailed $ do
-        let rep = fromMaybe "https://github.com/haskell/haskell-language-server.git" repo
-        lift $ logInfo $ "Fetching git repo " <> T.pack rep <> " at ref " <> T.pack ref <> " (this may take a while)"
-        lEM $ git [ "init" ]
-        lEM $ git [ "remote"
-                  , "add"
-                  , "origin"
-                  , fromString rep ]
-
-        -- figure out if we can do a shallow clone
-        remoteBranches <- catchE @ProcessError @'[ProcessError] @'[] (\_ -> pure [])
-            $ fmap processBranches $ gitOut ["ls-remote", "--heads", "origin"] (fromGHCupPath tmpUnpack)
-        let shallow_clone
-              | gitDescribeRequested                 = False
-              | isCommitHash ref                     = True
-              | fromString ref `elem` remoteBranches = True
-              | otherwise                            = False
-
-        lift $ logDebug $ "Shallow clone: " <> T.pack (show shallow_clone)
-
-        -- fetch
-        let fetch_args
-              | shallow_clone = ["fetch", "--depth", "1", "--quiet", "origin", fromString ref]
-              | otherwise     = ["fetch", "--tags",       "--quiet", "origin"                ]
-        lEM $ git fetch_args
-
-        -- checkout
-        lEM $ git [ "checkout", fromString ref ]
-
-        -- gather some info
-        git_describe <- if shallow_clone
-                        then pure Nothing
-                        else fmap Just $ gitOut ["describe", "--tags"] (fromGHCupPath tmpUnpack)
-        chash <- gitOut ["rev-parse", "HEAD" ] (fromGHCupPath tmpUnpack)
-        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  " <>
-                                    "HLS version (from cabal file): " <> 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)
-
-        pure (tmpUnpack, tmpUnpack, tver, git_describe)
-
-  -- the version that's installed may differ from the
-  -- compiled version, so the user can overwrite it
-  installVer <- case ov of
-                  Left True -> case git_describe of
-                                 -- git describe
-                                 Just h -> either (fail . displayException) pure . version $ h
-                                 -- git describe, but not building from git, lol
-                                 Nothing -> pure tver
-                  -- default: use detected version
-                  Left False -> pure tver
-                  -- overwrite version with users value
-                  Right v -> pure v
-
-  liftE $ runBuildAction
-    tmpUnpack
-    (reThrowAll @_ @'[GPGError, DownloadFailed, DigestError, ContentLengthError, PatchFailed, ProcessError, FileAlreadyExistsError, CopyError] @'[BuildFailed] (BuildFailed $ fromGHCupPath workdir) $ do
-      let tmpInstallDir = fromGHCupPath workdir </> "out"
-      liftIO $ createDirRecursive' tmpInstallDir
-
-      -- apply patches
-      liftE $ applyAnyPatch patches (fromGHCupPath workdir)
-
-      -- set up project files
-      cp <- case cabalProject of
-        Just (Left cp)
-          | isAbsolute cp -> do
-              copyFileE cp (fromGHCupPath workdir </> "cabal.project") False
-              pure "cabal.project"
-          | otherwise -> pure (takeFileName cp)
-        Just (Right uri) -> do
-          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
-          | 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 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)
-        liftIO $ createDirRecursive' tmpInstallDir
-        lift $ logInfo $ "Building HLS " <> prettyVer installVer <> " for GHC version " <> prettyVer ghc
-        liftE $ lEM @_ @'[ProcessError] $
-          execLogged "cabal" ( [ "v2-install"
-                               , "-w"
-                               , "ghc-" <> T.unpack (prettyVer ghc)
-                               , "--install-method=copy"
-                               ] ++
-                               maybe [] (\j -> ["--jobs=" <> show j]) jobs ++
-                               [ "--overwrite-policy=always"
-                               , "--disable-profiling"
-                               , "--disable-tests"
-                               , "--installdir=" <> ghcInstallDir
-                               , "--project-file=" <> cp
-                               ] ++ fmap T.unpack cabalArgs ++ [
-                                 "exe:haskell-language-server"
-                               , "exe:haskell-language-server-wrapper"]
-                             )
-                             (Just $ fromGHCupPath workdir)
-                             "cabal"
-                             Nothing
-        pure ghcInstallDir
-
-      forM_ artifacts $ \artifact -> do
-        logDebug $ T.pack (show artifact)
-        liftIO $ renameFile (artifact </> "haskell-language-server" <.> exeExt)
-          (tmpInstallDir </> "haskell-language-server-" <> takeFileName artifact <.> exeExt)
-        liftIO $ renameFile (artifact </> "haskell-language-server-wrapper" <.> exeExt)
-          (tmpInstallDir </> "haskell-language-server-wrapper" <.> exeExt)
-
-      case installDir of
-        IsolateDir isoDir -> do
-          lift $ logInfo $ "isolated installing HLS to " <> T.pack isoDir
-          liftE $ installHLSUnpackedLegacy tmpInstallDir (IsolateDirResolved isoDir) installVer True
-        GHCupInternal -> do
-          liftE $ installHLSUnpackedLegacy tmpInstallDir (GHCupBinDir binDir) installVer True
-    )
-
-  pure installVer
- where
-  gitDescribeRequested = case ov of
-                           Left b -> b
-                           _      -> False
-
-
-    -----------------
-    --[ Set/Unset ]--
-    -----------------
-
--- | Set the haskell-language-server symlinks.
-setHLS :: ( MonadReader env m
-          , HasDirs env
-          , HasLog env
-          , MonadIO m
-          , MonadMask m
-          , MonadFail m
-          , MonadUnliftIO m
-          )
-       => Version
-       -> SetHLS
-       -> Maybe FilePath  -- if set, signals that we're not operating in ~/.ghcup/bin
-                          -- and don't want mess with other versions
-       -> Excepts '[NotInstalled] m ()
-setHLS ver shls mBinDir = do
-  whenM (lift $ not <$> hlsInstalled ver) (throwE (NotInstalled HLS (GHCTargetVersion Nothing ver)))
-
-  -- symlink destination
-  binDir <- case mBinDir of
-    Just x -> pure x
-    Nothing -> do
-      Dirs {binDir = f} <- lift getDirs
-      pure f
-
-  -- first delete the old symlinks
-  when (isNothing mBinDir) $
-    case shls of
-      -- not for legacy
-      SetHLS_XYZ -> liftE $ rmMinorHLSSymlinks ver
-      -- legacy and new
-      SetHLSOnly -> liftE rmPlainHLS
-
-  case shls of
-    -- not for legacy
-    SetHLS_XYZ -> do
-      bins <- lift $ hlsInternalServerScripts ver Nothing
-
-      forM_ bins $ \f -> do
-        let fname = takeFileName f
-        destL <- binarySymLinkDestination binDir f
-        let target = if "haskell-language-server-wrapper" `isPrefixOf` fname
-                     then fname <> "-" <> T.unpack (prettyVer ver) <> exeExt
-                     else fname <> "~" <> T.unpack (prettyVer ver) <> exeExt
-        lift $ createLink destL (binDir </> target)
-
-    -- legacy and new
-    SetHLSOnly -> do
-      -- set haskell-language-server-<ghcver> symlinks
-      bins <- lift $ hlsServerBinaries ver Nothing
-      when (null bins) $ throwE $ NotInstalled HLS (GHCTargetVersion Nothing ver)
-
-      forM_ bins $ \f -> do
-        let destL = f
-        let target = (<> exeExt) . head . splitOn "~" $ f
-        lift $ createLink destL (binDir </> target)
-
-      -- set haskell-language-server-wrapper symlink
-      let destL = "haskell-language-server-wrapper-" <> T.unpack (prettyVer ver) <> exeExt
-      let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
-
-      lift $ createLink destL wrapper
-
-      when (isNothing mBinDir) $
-        lift warnAboutHlsCompatibility
-
-      liftIO (isShadowed wrapper) >>= \case
-        Nothing -> pure ()
-        Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed HLS pa wrapper ver)
-
-
-unsetHLS :: ( MonadMask m
-            , MonadReader env m
-            , HasDirs env
-            , MonadIO m)
-         => m ()
-unsetHLS = do
-  Dirs {..} <- getDirs
-  let wrapper = binDir </> "haskell-language-server-wrapper" <> exeExt
-  bins   <- liftIO $ handleIO (\_ -> pure []) $ findFiles'
-    binDir
-    (MP.chunk "haskell-language-server-" <* pvp' <* MP.chunk (T.pack exeExt) <* MP.eof)
-  forM_ bins (hideError doesNotExistErrorType . rmLink . (binDir </>))
-  hideError doesNotExistErrorType $ rmLink wrapper
-
-
-
-
-    ---------------
-    --[ Removal ]--
-    ---------------
-
-
--- | Delete a hls version. Will try to fix the hls symlinks
--- after removal (e.g. setting it to an older version).
-rmHLSVer :: ( MonadMask m
-            , MonadReader env m
-            , HasDirs env
-            , MonadThrow m
-            , HasLog env
-            , MonadIO m
-            , MonadFail m
-            , MonadCatch m
-            , MonadUnliftIO m
-            )
-         => Version
-         -> Excepts '[NotInstalled, UninstallFailed] m ()
-rmHLSVer ver = do
-  whenM (lift $ fmap not $ hlsInstalled ver) $ throwE (NotInstalled HLS (GHCTargetVersion Nothing ver))
-
-  isHlsSet <- lift hlsSet
-
-  liftE $ rmMinorHLSSymlinks ver
-
-  when (Just ver == isHlsSet) $ do
-    -- delete all set symlinks
-    liftE rmPlainHLS
-
-  hlsDir' <- ghcupHLSDir ver
-  let hlsDir = fromGHCupPath hlsDir'
-  lift (getInstalledFiles HLS (mkTVer ver)) >>= \case
-    Just files -> do
-      lift $ logInfo $ "Removing files safely from: " <> T.pack hlsDir
-      forM_ files (lift . hideError NoSuchThing . recycleFile . (\f -> hlsDir </> dropDrive f))
-      removeEmptyDirsRecursive hlsDir
-      survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory hlsDir
-      f <- recordedInstallationFile HLS (mkTVer ver)
-      lift $ recycleFile f
-      when (not (null survivors)) $ throwE $ UninstallFailed hlsDir survivors
-    Nothing -> do
-      isDir <- liftIO $ doesDirectoryExist hlsDir
-      isSyml <- liftIO $ handleIO (\_ -> pure False) $ pathIsSymbolicLink hlsDir
-      when (isDir && not isSyml) $ do
-        lift $ logInfo $ "Removing legacy directory recursively: " <> T.pack hlsDir
-        recyclePathForcibly hlsDir'
-
-  when (Just ver == isHlsSet) $ do
-    -- set latest hls
-    hlsVers <- lift $ fmap rights getInstalledHLSs
-    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/List.hs

@@ -1,410 +0,0 @@
-{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-
-{-|
-Module      : GHCup.List
-Description : Listing versions and tools
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : portable
--}
-module GHCup.List where
-
-import           GHCup.Download
-import           GHCup.Errors
-import           GHCup.Types
-import           GHCup.Types.JSON               ( )
-import           GHCup.Types.Optics
-import           GHCup.Utils
-import           GHCup.Prelude.Logger
-import           GHCup.Version
-
-import           Control.Applicative
-import           Control.Exception.Safe
-import           Control.Monad
-#if !MIN_VERSION_base(4,13,0)
-import           Control.Monad.Fail             ( MonadFail )
-#endif
-import           Control.Monad.Reader
-import           Data.Either
-import           Data.List
-import           Data.Maybe
-import           Data.Text                      ( Text )
-import           Data.Versions                hiding ( patch )
-import           Haskus.Utils.Variant.Excepts
-import           Optics
-import           Prelude                 hiding ( abs
-                                                , writeFile
-                                                )
-
-import qualified Data.Map.Strict               as Map
-import qualified Data.Text                     as T
-
-
-
-
-
-
-
-
-
-
-    ------------------
-    --[ List tools ]--
-    ------------------
-
-
--- | Filter data type for 'listVersions'.
-data ListCriteria = ListInstalled
-                  | ListSet
-                  | ListAvailable
-                  deriving Show
-
--- | A list result describes a single tool version
--- and various of its properties.
-data ListResult = ListResult
-  { lTool      :: Tool
-  , lVer       :: Version
-  , lCross     :: Maybe Text -- ^ currently only for GHC
-  , lTag       :: [Tag]
-  , lInstalled :: Bool
-  , lSet       :: Bool -- ^ currently active version
-  , fromSrc    :: Bool -- ^ compiled from source
-  , lStray     :: Bool -- ^ not in download info
-  , lNoBindist :: Bool -- ^ whether the version is available for this platform/arch
-  , hlsPowered :: Bool
-  }
-  deriving (Eq, Ord, Show)
-
-
--- | Extract all available tool versions and their tags.
-availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
-availableToolVersions av tool = view
-  (at tool % non Map.empty)
-  av
-
-
--- | List all versions from the download info, as well as stray
--- versions.
-listVersions :: ( MonadCatch m
-                , HasLog env
-                , MonadThrow m
-                , HasLog env
-                , MonadIO m
-                , MonadReader env m
-                , HasDirs env
-                , HasPlatformReq env
-                , HasGHCupInfo env
-                )
-             => Maybe Tool
-             -> Maybe ListCriteria
-             -> m [ListResult]
-listVersions lt' criteria = do
-  -- some annoying work to avoid too much repeated IO
-  cSet <- cabalSet
-  cabals <- getInstalledCabals
-  hlsSet' <- hlsSet
-  hlses <- getInstalledHLSs
-  sSet <- stackSet
-  stacks <- getInstalledStacks
-
-  go lt' cSet cabals hlsSet' hlses sSet stacks
- where
-  go lt cSet cabals hlsSet' hlses sSet stacks = do
-    case lt of
-      Just t -> do
-        GHCupInfo { _ghcupDownloads = dls } <- getGHCupInfo
-        -- get versions from GHCupDownloads
-        let avTools = availableToolVersions dls t
-        lr <- filter' <$> forM (Map.toList avTools) (toListResult t cSet cabals hlsSet' hlses sSet stacks)
-
-        case t of
-          GHC -> do
-            slr <- strayGHCs avTools
-            pure (sort (slr ++ lr))
-          Cabal -> do
-            slr <- strayCabals avTools cSet cabals
-            pure (sort (slr ++ lr))
-          HLS -> do
-            slr <- strayHLS avTools hlsSet' hlses
-            pure (sort (slr ++ lr))
-          Stack -> do
-            slr <- strayStacks avTools sSet stacks
-            pure (sort (slr ++ lr))
-          GHCup -> do
-            let cg = maybeToList $ currentGHCup avTools
-            pure (sort (cg ++ lr))
-      Nothing -> do
-        ghcvers   <- go (Just GHC) cSet cabals hlsSet' hlses sSet stacks
-        cabalvers <- go (Just Cabal) cSet cabals hlsSet' hlses sSet stacks
-        hlsvers   <- go (Just HLS) cSet cabals hlsSet' hlses sSet stacks
-        ghcupvers <- go (Just GHCup) cSet cabals hlsSet' hlses sSet stacks
-        stackvers <- go (Just Stack) cSet cabals hlsSet' hlses sSet stacks
-        pure (ghcvers <> cabalvers <> hlsvers <> stackvers <> ghcupvers)
-  strayGHCs :: ( MonadCatch m
-               , MonadReader env m
-               , HasDirs env
-               , MonadThrow m
-               , HasLog env
-               , MonadIO m
-               )
-            => Map.Map Version VersionInfo
-            -> m [ListResult]
-  strayGHCs avTools = do
-    ghcs <- getInstalledGHCs
-    fmap catMaybes $ forM ghcs $ \case
-      Right tver@GHCTargetVersion{ _tvTarget = Nothing, .. } -> do
-        case Map.lookup _tvVersion avTools of
-          Just _  -> pure Nothing
-          Nothing -> do
-            lSet    <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet Nothing
-            fromSrc <- ghcSrcInstalled tver
-            hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
-            pure $ Just $ ListResult
-              { lTool      = GHC
-              , lVer       = _tvVersion
-              , lCross     = Nothing
-              , lTag       = []
-              , lInstalled = True
-             , lStray     = isNothing (Map.lookup _tvVersion avTools)
-              , lNoBindist = False
-              , ..
-              }
-      Right tver@GHCTargetVersion{ .. } -> do
-        lSet    <- fmap (maybe False (\(GHCTargetVersion _ v ) -> v == _tvVersion)) $ ghcSet _tvTarget
-        fromSrc <- ghcSrcInstalled tver
-        hlsPowered <- fmap (elem _tvVersion) hlsGHCVersions
-        pure $ Just $ ListResult
-          { lTool      = GHC
-          , lVer       = _tvVersion
-          , lCross     = _tvTarget
-          , lTag       = []
-          , lInstalled = True
-          , lStray     = True -- NOTE: cross currently cannot be installed via bindist
-          , lNoBindist = False
-          , ..
-          }
-      Left e -> do
-        logWarn
-          $ "Could not parse version of stray directory" <> T.pack e
-        pure Nothing
-
-  strayCabals :: ( MonadReader env m
-                 , HasDirs env
-                 , MonadCatch m
-                 , MonadThrow m
-                 , HasLog env
-                 , MonadIO m
-                 )
-            => Map.Map Version VersionInfo
-            -> Maybe Version
-            -> [Either FilePath Version]
-            -> m [ListResult]
-  strayCabals avTools cSet cabals = do
-    fmap catMaybes $ forM cabals $ \case
-      Right ver ->
-        case Map.lookup ver avTools of
-          Just _  -> pure Nothing
-          Nothing -> do
-            let lSet = cSet == Just ver
-            pure $ Just $ ListResult
-              { lTool      = Cabal
-              , lVer       = ver
-              , lCross     = Nothing
-              , lTag       = []
-              , lInstalled = True
-              , lStray     = isNothing (Map.lookup ver avTools)
-              , lNoBindist = False
-              , fromSrc    = False -- actually, we don't know :>
-              , hlsPowered = False
-              , ..
-              }
-      Left e -> do
-        logWarn
-          $ "Could not parse version of stray directory" <> T.pack e
-        pure Nothing
-
-  strayHLS :: ( MonadReader env m
-              , HasDirs env
-              , MonadCatch m
-              , MonadThrow m
-              , HasLog env
-              , MonadIO m)
-           => Map.Map Version VersionInfo
-           -> Maybe Version
-           -> [Either FilePath Version]
-           -> m [ListResult]
-  strayHLS avTools hlsSet' hlss = do
-    fmap catMaybes $ forM hlss $ \case
-      Right ver ->
-        case Map.lookup ver avTools of
-          Just _  -> pure Nothing
-          Nothing -> do
-            let lSet = hlsSet' == Just ver
-            pure $ Just $ ListResult
-              { lTool      = HLS
-              , lVer       = ver
-              , lCross     = Nothing
-              , lTag       = []
-              , lInstalled = True
-              , lStray     = isNothing (Map.lookup ver avTools)
-              , lNoBindist = False
-              , fromSrc    = False -- actually, we don't know :>
-              , hlsPowered = False
-              , ..
-              }
-      Left e -> do
-        logWarn
-          $ "Could not parse version of stray directory" <> T.pack e
-        pure Nothing
-
-  strayStacks :: ( MonadReader env m
-                 , HasDirs env
-                 , MonadCatch m
-                 , MonadThrow m
-                 , HasLog env
-                 , MonadIO m
-                 )
-              => Map.Map Version VersionInfo
-              -> Maybe Version
-              -> [Either FilePath Version]
-              -> m [ListResult]
-  strayStacks avTools stackSet' stacks = do
-    fmap catMaybes $ forM stacks $ \case
-      Right ver ->
-        case Map.lookup ver avTools of
-          Just _  -> pure Nothing
-          Nothing -> do
-            let lSet = stackSet' == Just ver
-            pure $ Just $ ListResult
-              { lTool      = Stack
-              , lVer       = ver
-              , lCross     = Nothing
-              , lTag       = []
-              , lInstalled = True
-              , lStray     = isNothing (Map.lookup ver avTools)
-              , lNoBindist = False
-              , fromSrc    = False -- actually, we don't know :>
-              , hlsPowered = False
-              , ..
-              }
-      Left e -> do
-        logWarn
-          $ "Could not parse version of stray directory" <> T.pack e
-        pure Nothing
-
-  currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
-  currentGHCup av =
-    let currentVer = fromJust $ pvpToVersion ghcUpVer ""
-        listVer    = Map.lookup currentVer av
-        latestVer  = fst <$> headOf (getTagged Latest) av
-        recommendedVer = fst <$> headOf (getTagged Latest) av
-        isOld  = maybe True (> currentVer) latestVer && maybe True (> currentVer) recommendedVer
-    in if | Map.member currentVer av -> Nothing
-          | otherwise -> Just $ ListResult { lVer    = currentVer
-                                           , lTag    = maybe (if isOld then [Old] else []) _viTags listVer
-                                           , lCross  = Nothing
-                                           , lTool   = GHCup
-                                           , fromSrc = False
-                                           , lStray  = isNothing listVer
-                                           , lSet    = True
-                                           , lInstalled = True
-                                           , lNoBindist = False
-                                           , hlsPowered = False
-                                           }
-
-  -- NOTE: this are not cross ones, because no bindists
-  toListResult :: ( HasLog env
-                  , MonadReader env m
-                  , HasDirs env
-                  , HasGHCupInfo env
-                  , HasPlatformReq env
-                  , MonadIO m
-                  , MonadCatch m
-                  )
-               => Tool
-               -> Maybe Version
-               -> [Either FilePath Version]
-               -> Maybe Version
-               -> [Either FilePath Version]
-               -> Maybe Version
-               -> [Either FilePath Version]
-               -> (Version, VersionInfo)
-               -> m ListResult
-  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, _viTags -> tags) = do
-    case t of
-      GHC -> do
-        lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo GHC v
-        let tver = mkTVer v
-        lSet       <- fmap (maybe False (\(GHCTargetVersion _ v') -> v' == v)) $ ghcSet Nothing
-        lInstalled <- ghcInstalled tver
-        fromSrc    <- ghcSrcInstalled tver
-        hlsPowered <- fmap (elem v) hlsGHCVersions
-        pure ListResult { lVer = v, lCross = Nothing , lTag = tags, lTool = t, lStray = False, .. }
-      Cabal -> do
-        lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Cabal v
-        let lSet = cSet == Just v
-        let lInstalled = elem v $ rights cabals
-        pure ListResult { lVer    = v
-                        , lCross  = Nothing
-                        , lTag    = tags
-                        , lTool   = t
-                        , fromSrc = False
-                        , lStray  = False
-                        , hlsPowered = False
-                        , ..
-                        }
-      GHCup -> do
-        let lSet       = prettyPVP ghcUpVer == prettyVer v
-        let lInstalled = lSet
-        pure ListResult { lVer    = v
-                        , lTag    = tags
-                        , lCross  = Nothing
-                        , lTool   = t
-                        , fromSrc = False
-                        , lStray  = False
-                        , lNoBindist = False
-                        , hlsPowered = False
-                        , ..
-                        }
-      HLS -> do
-        lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo HLS v
-        let lSet = hlsSet' == Just v
-        let lInstalled = elem v $ rights hlses
-        pure ListResult { lVer    = v
-                        , lCross  = Nothing
-                        , lTag    = tags
-                        , lTool   = t
-                        , fromSrc = False
-                        , lStray  = False
-                        , hlsPowered = False
-                        , ..
-                        }
-      Stack -> do
-        lNoBindist <- fmap (isLeft . veitherToEither) $ runE @'[NoDownload] $ getDownloadInfo Stack v
-        let lSet = stackSet' == Just v
-        let lInstalled = elem v $ rights stacks
-        pure ListResult { lVer    = v
-                        , lCross  = Nothing
-                        , lTag    = tags
-                        , lTool   = t
-                        , fromSrc = False
-                        , lStray  = False
-                        , hlsPowered = False
-                        , ..
-                        }
-
-
-  filter' :: [ListResult] -> [ListResult]
-  filter' lr = case criteria of
-    Nothing            -> lr
-    Just ListInstalled -> filter (\ListResult {..} -> lInstalled) lr
-    Just ListSet       -> filter (\ListResult {..} -> lSet) lr
-    Just ListAvailable -> filter (\ListResult {..} -> not lNoBindist) lr
-

lib/GHCup/Platform.hs

@@ -24,10 +24,10 @@ import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
-import           GHCup.Prelude
-import           GHCup.Prelude.Logger
-import           GHCup.Prelude.Process
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.File
+import           GHCup.Utils.Logger
+import           GHCup.Utils.Prelude
+import           GHCup.Utils.String.QQ
 
 #if !MIN_VERSION_base(4,13,0)
 import           Control.Monad.Fail             ( MonadFail )

lib/GHCup/Prelude.hs

@@ -1,84 +0,0 @@
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE TypeOperators       #-}
-
-{-|
-Module      : GHCup.Prelude
-Description : MegaParsec utilities
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : portable
-
-GHCup specific prelude. Lots of Excepts functionality.
--}
-module GHCup.Prelude
-  (module GHCup.Prelude,
-   module GHCup.Prelude.Internal,
-#if defined(IS_WINDOWS)
-   module GHCup.Prelude.Windows
-#else
-   module GHCup.Prelude.Posix
-#endif
-  )
-where
-
-import           GHCup.Errors
-import           GHCup.Prelude.Internal
-import           GHCup.Types.Optics   (HasLog)
-import           GHCup.Prelude.Logger (logWarn)
-#if defined(IS_WINDOWS)
-import GHCup.Prelude.Windows
-#else
-import GHCup.Prelude.Posix
-#endif
-
-import           Control.Monad.IO.Class
-import           Control.Monad.Reader
-import           Haskus.Utils.Variant.Excepts
-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 . 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)
-             )
-          => Excepts e m a
-          -> Excepts e m b
-          -> Excepts (InstallSetError ': e) m ()
-runBothE' a1 a2 = do
-   r1 <- lift $ runE @e a1
-   r2 <- lift $ runE @e a2
-   case (r1, r2) of
-      (VLeft e1, VLeft e2) -> throwE (InstallSetError e1 e2)
-      (VLeft e , _       ) -> throwSomeE e
-      (_       , VLeft e ) -> throwSomeE e
-      (VRight _, VRight _) -> pure ()
-
-
--- | Throw some exception
-throwSomeE :: forall es' es a m. (Monad m, LiftVariant es' es) => V es' -> Excepts es m a
-{-# INLINABLE throwSomeE #-}
-throwSomeE = Excepts . pure . VLeft . liftVariant

lib/GHCup/Prelude/File.hs

@@ -1,426 +0,0 @@
-{-# LANGUAGE CPP                 #-}
-{-# LANGUAGE BangPatterns        #-}
-{-# LANGUAGE DataKinds           #-}
-{-# LANGUAGE FlexibleContexts    #-}
-{-# LANGUAGE FlexibleInstances   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE TypeFamilies        #-}
-{-# LANGUAGE TypeOperators       #-}
-
-module GHCup.Prelude.File (
-  mergeFileTree,
-  copyFileE,
-  findFilesDeep,
-  getDirectoryContentsRecursive,
-  getDirectoryContentsRecursiveBFS,
-  getDirectoryContentsRecursiveDFS,
-  getDirectoryContentsRecursiveUnsafe,
-  getDirectoryContentsRecursiveBFSUnsafe,
-  getDirectoryContentsRecursiveDFSUnsafe,
-  recordedInstallationFile,
-  module GHCup.Prelude.File.Search,
-
-  chmod_755,
-  isBrokenSymlink,
-  copyFile,
-  deleteFile,
-  install,
-  removeEmptyDirectory,
-  removeDirIfEmptyOrIsSymlink,
-  removeEmptyDirsRecursive,
-  rmFileForce,
-  createDirRecursive',
-  recyclePathForcibly,
-  rmDirectory,
-  recycleFile,
-  rmFile,
-  rmDirectoryLink,
-  moveFilePortable,
-  moveFile,
-  rmPathForcibly,
-
-  exeExt,
-  exeExt',
-  getLinkTarget,
-  pathIsLink,
-  rmLink,
-  createLink
-) where
-
-import GHCup.Utils.Dirs
-import GHCup.Prelude.Logger.Internal (logInfo, logDebug)
-import GHCup.Prelude.Internal
-import GHCup.Prelude.File.Search
-#if IS_WINDOWS
-import GHCup.Prelude.File.Windows
-import GHCup.Prelude.Windows
-#else
-import GHCup.Prelude.File.Posix
-import GHCup.Prelude.Posix
-#endif
-import           GHCup.Errors
-import           GHCup.Types
-import           GHCup.Types.Optics
-
-import           Text.Regex.Posix
-import           Control.Monad.IO.Unlift        ( MonadUnliftIO )
-import           Control.Exception.Safe
-import           Control.Monad.Reader
-import           Data.ByteString                ( ByteString )
-import           Haskus.Utils.Variant.Excepts
-import           System.FilePath
-import           Text.PrettyPrint.HughesPJClass (prettyShow)
-
-import qualified Data.Text                     as T
-import qualified Streamly.Prelude              as S
-import Control.DeepSeq (force)
-import Control.Exception (evaluate)
-import GHC.IO.Exception
-import System.IO.Error
-
-
--- | Merge one file tree to another given a copy operation.
---
--- Records every successfully installed file into the destination
--- returned by 'recordedInstallationFile'.
---
--- If any copy operation fails, the record file is deleted, as well
--- as the partially installed files.
-mergeFileTree :: ( MonadMask m
-                 , S.MonadAsync m
-                 , MonadReader env m
-                 , HasDirs env
-                 , HasLog env
-                 , MonadCatch m
-                 )
-              => GHCupPath                       -- ^ source base directory from which to install findFiles
-              -> InstallDirResolved              -- ^ destination base dir
-              -> Tool
-              -> GHCTargetVersion
-              -> (FilePath -> FilePath -> m ())  -- ^ file copy operation
-              -> Excepts '[MergeFileTreeError] m ()
-mergeFileTree _ (GHCupBinDir fp) _ _ _ =
-  throwIO $ userError ("mergeFileTree: internal error, called on " <> fp)
-mergeFileTree sourceBase destBase tool v' copyOp = do
-  lift $ logInfo $ "Merging file tree from \""
-       <> T.pack (fromGHCupPath sourceBase)
-       <> "\" to \""
-       <> T.pack (fromInstallDir destBase)
-       <> "\""
-  recFile <- recordedInstallationFile tool v'
-
-  wrapInExcepts $ do
-    -- These checks are not atomic, but we perform them to have
-    -- the opportunity to abort before copying has started.
-    --
-    -- The actual copying might still fail.
-    liftIO $ baseCheck (fromGHCupPath sourceBase)
-    liftIO $ destCheck (fromInstallDir destBase)
-
-    -- we only record for non-isolated installs
-    when (isSafeDir destBase) $ do
-      whenM (liftIO $ doesFileExist recFile)
-        $ throwIO $ userError ("mergeFileTree: DB file " <> recFile <> " already exists!")
-      liftIO $ createDirectoryIfMissing True (takeDirectory recFile)
-
-  -- we want the cleanup action to leak through in case of exception
-  onE_ (cleanupOnPartialInstall recFile) $ wrapInExcepts $ do
-    logDebug "Starting merge"
-    lift $ flip S.mapM_ (getDirectoryContentsRecursive sourceBase) $ \f -> do
-      copy f
-      logDebug $ T.pack "Recording installed file: " <> T.pack f
-      recordInstalledFile f recFile
-      pure f
-
- where
-  wrapInExcepts = handleIO (\e -> throwE $ MergeFileTreeError e (fromGHCupPath sourceBase) (fromInstallDir destBase))
-
-  cleanupOnPartialInstall recFile = when (isSafeDir destBase) $ do
-    (force -> !l) <- hideErrorDef [NoSuchThing] [] $ lines <$> liftIO
-      (readFile recFile >>= evaluate)
-    logDebug "Deleting recorded files due to partial install"
-    forM_ l $ \f -> do
-      let dest = fromInstallDir destBase </> dropDrive f
-      logDebug $ "rm -f " <> T.pack f
-      hideError NoSuchThing $ rmFile dest
-      pure ()
-    logDebug $ "rm -f " <> T.pack recFile
-    hideError NoSuchThing $ rmFile recFile
-    logDebug $ "rm -f " <> T.pack (fromInstallDir destBase)
-    hideError UnsatisfiedConstraints $ hideError NoSuchThing $
-      removeEmptyDirsRecursive (fromInstallDir destBase)
-
-
-  recordInstalledFile f recFile = when (isSafeDir destBase) $
-    liftIO $ appendFile recFile (f <> "\n")
-
-  copy source = do
-    let dest = fromInstallDir destBase </> source
-        src  = fromGHCupPath sourceBase </> source
-
-    when (isAbsolute source)
-      $ throwIO $ userError ("mergeFileTree: source file " <> source <> " is not relative!")
-
-    liftIO . createDirectoryIfMissing True . takeDirectory $ dest
-
-    copyOp src dest
-
-
-  baseCheck src = do
-      when (isRelative src)
-        $ throwIO $ userError ("mergeFileTree: source base directory " <> src <> " is not absolute!")
-      whenM (not <$> doesDirectoryExist src)
-        $ throwIO $ userError ("mergeFileTree: source base directory " <> src <> " does not exist!")
-  destCheck dest = do
-      when (isRelative dest)
-        $ throwIO $ userError ("mergeFileTree: destination base directory " <> dest <> " is not absolute!")
-
-
-
-copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Bool -> Excepts xs m ()
-copyFileE from to = handleIO (throwE . CopyError . show) . liftIO . copyFile from to
-
-
--- | List all the files in a directory and all subdirectories.
---
--- The order places files in sub-directories after all the files in their
--- parent directories. The list is generated lazily so is not well defined if
--- the source directory structure changes before the list is used.
---
--- depth first
-getDirectoryContentsRecursiveDFS :: (MonadCatch m, S.MonadAsync m, MonadMask m)
-                                 => GHCupPath
-                                 -> S.SerialT m FilePath
-getDirectoryContentsRecursiveDFS (fromGHCupPath -> fp) = getDirectoryContentsRecursiveDFSUnsafe fp
-
--- breadth first
-getDirectoryContentsRecursiveBFS :: (MonadCatch m, S.MonadAsync m, MonadMask m)
-                                 => GHCupPath
-                                 -> S.SerialT m FilePath
-getDirectoryContentsRecursiveBFS (fromGHCupPath -> fp) = getDirectoryContentsRecursiveBFSUnsafe fp
-
-
-getDirectoryContentsRecursive :: (MonadCatch m, S.MonadAsync m, MonadMask m)
-                              => GHCupPath
-                              -> S.SerialT m FilePath
-getDirectoryContentsRecursive = getDirectoryContentsRecursiveBFS
-
-getDirectoryContentsRecursiveUnsafe :: (MonadCatch m, S.MonadAsync m, MonadMask m)
-                                    => FilePath
-                                    -> S.SerialT m FilePath
-getDirectoryContentsRecursiveUnsafe = getDirectoryContentsRecursiveBFSUnsafe
-
-findFilesDeep :: GHCupPath -> Regex -> IO [FilePath]
-findFilesDeep path regex =
-  S.toList $ S.filter (match regex) $ getDirectoryContentsRecursive path
-
-
-recordedInstallationFile :: ( MonadReader env m
-                            , HasDirs env
-                            )
-                         => Tool
-                         -> GHCTargetVersion
-                         -> m FilePath
-recordedInstallationFile t v' = do
-  Dirs {..}  <- getDirs
-  pure (fromGHCupPath dbDir </> prettyShow t </> T.unpack (tVerToText v'))
-
-removeDirIfEmptyOrIsSymlink :: (MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
-removeDirIfEmptyOrIsSymlink filepath =
-  hideError UnsatisfiedConstraints $
-  handleIO' InappropriateType
-        (handleIfSym filepath)
-        (liftIO $ removeEmptyDirectory filepath)
-  where
-    handleIfSym fp e = do
-      isSym <- liftIO $ pathIsSymbolicLink fp
-      if isSym
-      then rmFileForce fp
-      else liftIO $ ioError e
-
-removeEmptyDirsRecursive :: (MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
-removeEmptyDirsRecursive = go
- where
-  go fp = do
-    cs <- liftIO $ listDirectory fp >>= filterM doesDirectoryExist . fmap (fp </>)
-    forM_ cs go
-    liftIO $ removeEmptyDirectory fp
-
-rmFileForce :: (MonadMask m, MonadIO m) => FilePath -> m ()
-rmFileForce filepath = do
-  hideError doesNotExistErrorType
-    $ hideError InappropriateType $ rmFile filepath
-
--- | More permissive version of 'createDirRecursive'. This doesn't
--- error when the destination is a symlink to a directory.
-createDirRecursive' :: FilePath -> IO ()
-createDirRecursive' p =
-  handleIO (\e -> if isAlreadyExistsError e then isSymlinkDir e else throwIO e)
-    . createDirectoryIfMissing True
-    $ p
-
- where
-  isSymlinkDir e = do
-    ft <- pathIsSymbolicLink p
-    case ft of
-      True -> do
-        rp <- canonicalizePath p
-        rft <- doesDirectoryExist rp
-        case rft of
-          True -> pure ()
-          _ -> throwIO e
-      _ -> throwIO e
-
-
--- https://github.com/haskell/directory/issues/110
--- https://github.com/haskell/directory/issues/96
--- https://www.sqlite.org/src/info/89f1848d7f
-recyclePathForcibly :: ( MonadIO m
-                       , MonadReader env m
-                       , HasDirs env
-                       , MonadMask m
-                       )
-                    => GHCupPath
-                    -> m ()
-recyclePathForcibly fp
-  | isWindows = do
-      Dirs { recycleDir } <- getDirs
-      tmp <- liftIO $ createTempGHCupDirectory recycleDir "recyclePathForcibly"
-      let dest = tmp `appendGHCupPath` takeFileName (fromGHCupPath fp)
-      liftIO (moveFile (fromGHCupPath fp) (fromGHCupPath dest))
-          `catch`
-          (\e -> if | isDoesNotExistError e -> pure ()
-                    | isPermissionError e || ioeGetErrorType e == UnsupportedOperation {- EXDEV on windows -} -> recover (liftIO $ removePathForcibly fp)
-                    | otherwise -> throwIO e)
-          `finally`
-            liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
-  | otherwise = liftIO $ removePathForcibly fp
-
-
-
-rmDirectory :: (MonadIO m, MonadMask m)
-            => GHCupPath
-            -> m ()
-rmDirectory fp
-  | isWindows = recover (liftIO $ removeDirectory fp)
-  | otherwise = liftIO $ removeDirectory fp
-
-
--- https://www.sqlite.org/src/info/89f1848d7f
--- https://github.com/haskell/directory/issues/96
-recycleFile :: ( MonadIO m
-               , MonadMask m
-               , MonadReader env m
-               , HasDirs env
-               )
-            => FilePath
-            -> m ()
-recycleFile fp
-  | isWindows = do
-      Dirs { recycleDir } <- getDirs
-      liftIO $ whenM (doesDirectoryExist fp) $ ioError (IOError Nothing InappropriateType "recycleFile" "" Nothing (Just fp))
-      tmp <- liftIO $ createTempGHCupDirectory recycleDir "recycleFile"
-      let dest = fromGHCupPath tmp </> takeFileName fp
-      liftIO (moveFile fp dest)
-        `catch`
-          (\e -> if isPermissionError e || ioeGetErrorType e == UnsupportedOperation {- EXDEV on windows -} then recover (liftIO $ rmFile fp) else throwIO e)
-        `finally`
-          liftIO (handleIO (\_ -> pure ()) $ removePathForcibly tmp)
-  | otherwise = liftIO $ removeFile fp
-
-
-rmFile :: ( MonadIO m
-          , MonadMask m
-          )
-      => FilePath
-      -> m ()
-rmFile fp
-  | isWindows = recover (liftIO $ removeFile fp)
-  | otherwise = liftIO $ removeFile fp
-
-
-rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
-                => FilePath
-                -> m ()
-rmDirectoryLink fp
-  | isWindows = recover (liftIO $ removeDirectoryLink fp)
-  | otherwise = liftIO $ removeDirectoryLink fp
-
-
-rmPathForcibly :: ( MonadIO m
-                  , MonadMask m
-                  )
-               => GHCupPath
-               -> m ()
-rmPathForcibly fp
-  | isWindows = recover (liftIO $ removePathForcibly fp)
-  | otherwise = liftIO $ removePathForcibly fp
-
-
--- | The file extension for executables.
-exeExt :: String
-exeExt
-  | isWindows = ".exe"
-  | otherwise = ""
-
--- | The file extension for executables.
-exeExt' :: ByteString
-exeExt'
-  | isWindows = ".exe"
-  | otherwise = ""
-
-
-rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
-rmLink fp
-  | isWindows = do
-      hideError doesNotExistErrorType . recycleFile $ fp
-      hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
-  | otherwise = hideError doesNotExistErrorType . recycleFile $ fp
-
-
--- | Creates a symbolic link on unix and a fake symlink on windows for
--- executables, which:
---     1. is a shim exe
---     2. has a corresponding .shim file in the same directory that
---        contains the target
---
--- This overwrites previously existing files.
---
--- On windows, this requires that 'ensureGlobalTools' was run beforehand.
-createLink :: ( MonadMask m
-              , MonadThrow m
-              , HasLog env
-              , MonadIO m
-              , MonadReader env m
-              , HasDirs env
-              , MonadUnliftIO m
-              , MonadFail m
-              )
-           => FilePath      -- ^ path to the target executable
-           -> FilePath      -- ^ path to be created
-           -> m ()
-createLink link exe
-  | isWindows = do
-      dirs <- getDirs
-      let shimGen = fromGHCupPath (cacheDir dirs) </> "gs.exe"
-
-      let shim = dropExtension exe <.> "shim"
-          -- For hardlinks, link needs to be absolute.
-          -- If link is relative, it's relative to the target exe.
-          -- Note that (</>) drops lhs when rhs is absolute.
-          fullLink = takeDirectory exe </> link
-          shimContents = "path = " <> fullLink
-
-      logDebug $ "rm -f " <> T.pack exe
-      rmLink exe
-
-      logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
-      liftIO $ copyFile shimGen exe False
-      liftIO $ writeFile shim shimContents
-  | otherwise = do
-      logDebug $ "rm -f " <> T.pack exe
-      hideError doesNotExistErrorType $ recycleFile exe
-
-      logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
-      liftIO $ createFileLink link exe

lib/GHCup/Prelude/File/Posix.hs

@@ -1,335 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE DataKinds  #-}
-{-# LANGUAGE MultiWayIf  #-}
-{-# LANGUAGE CApiFFI #-}
-
-{-|
-Module      : GHCup.Utils.File.Posix
-Description : File and directory handling for unix
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : POSIX
--}
-module GHCup.Prelude.File.Posix where
-
-import           GHCup.Prelude.File.Posix.Traversals
-
-import           Control.Exception.Safe
-import           Control.Monad.Reader
-import           Foreign.C.String
-import           Foreign.C.Error
-import           Foreign.C.Types
-import           System.IO                      ( hClose, hSetBinaryMode )
-import           System.IO.Error      hiding    ( catchIOError )
-import           System.FilePath
-import           System.Directory               ( removeFile, pathIsSymbolicLink, getSymbolicLinkTarget, doesPathExist )
-import           System.Posix.Directory
-import           System.Posix.Error             ( throwErrnoPathIfMinus1Retry )
-import           System.Posix.Internals         ( withFilePath )
-import           System.Posix.Files
-import           System.Posix.Types
-
-
-import qualified System.Posix.Directory        as PD
-import qualified System.Posix.Files            as PF
-import qualified System.Posix.IO               as SPI
-import qualified System.Posix as Posix
-import qualified Streamly.FileSystem.Handle    as FH
-import qualified Streamly.Internal.FileSystem.Handle
-                                               as IFH
-import qualified Streamly.Prelude              as S
-import qualified GHCup.Prelude.File.Posix.Foreign as FD
-import qualified Streamly.Internal.Data.Stream.StreamD.Type
-                                               as D
-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
--- symbolic link target.
---
--- On windows, we have to emulate symlinks via shims,
--- see 'createLink'.
-getLinkTarget :: FilePath -> IO FilePath
-getLinkTarget = getSymbolicLinkTarget
-
-
--- | Checks whether the path is a link.
-pathIsLink :: FilePath -> IO Bool
-pathIsLink = pathIsSymbolicLink
-
-
-chmod_755 :: MonadIO m => FilePath -> m ()
-chmod_755 fp = do
-  let exe_mode =
-          nullFileMode
-            `unionFileModes` ownerExecuteMode
-            `unionFileModes` ownerReadMode
-            `unionFileModes` ownerWriteMode
-            `unionFileModes` groupExecuteMode
-            `unionFileModes` groupReadMode
-            `unionFileModes` otherExecuteMode
-            `unionFileModes` otherReadMode
-  liftIO $ setFileMode fp exe_mode
-
-
--- |Default permissions for a new file.
-newFilePerms :: FileMode
-newFilePerms =
-  ownerWriteMode
-    `unionFileModes` ownerReadMode
-    `unionFileModes` groupWriteMode
-    `unionFileModes` groupReadMode
-    `unionFileModes` otherWriteMode
-    `unionFileModes` otherReadMode
-
-
--- | Checks whether the binary is a broken link.
-isBrokenSymlink :: FilePath -> IO Bool
-isBrokenSymlink fp = do
-  try (pathIsSymbolicLink fp) >>= \case
-    Right True -> do
-      let symDir = takeDirectory fp
-      tfp <- getSymbolicLinkTarget fp
-      not <$> doesPathExist
-        -- this drops 'symDir' if 'tfp' is absolute
-        (symDir </> tfp)
-    Right b -> pure b
-    Left e | isDoesNotExistError e -> pure False
-           | otherwise -> throwIO e
-
-copyFile :: FilePath   -- ^ source file
-         -> FilePath   -- ^ destination file
-         -> Bool       -- ^ fail if file exists
-         -> IO ()
-copyFile from to fail' = do
-  bracket
-    (openFdHandle from SPI.ReadOnly [FD.oNofollow] Nothing)
-    (hClose . snd)
-    $ \(fromFd, fH) -> do
-        sourceFileMode <- fileMode <$> getFdStatus fromFd
-        let dflags = [ FD.oNofollow
-                     , if fail' then FD.oExcl else FD.oTrunc
-                     ]
-        let openFdHandle' = openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode
-        bracket
-          (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
-              hSetBinaryMode tH True
-              streamlyCopy (fH, tH)
- where
-  openFdHandle fp omode flags fM = do
-    fd      <- openFd' fp omode flags fM
-    handle' <- SPI.fdToHandle fd
-    pure (fd, handle')
-  streamlyCopy (fH, tH) =
-    S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256 * 1024) fH
-
-foreign import capi unsafe "fcntl.h open"
-   c_open :: CString -> CInt -> Posix.CMode -> IO CInt
-
-
-open_  :: CString
-       -> Posix.OpenMode
-       -> [FD.Flags]
-       -> Maybe Posix.FileMode
-       -> IO Posix.Fd
-open_ str how optional_flags maybe_mode = do
-    fd <- c_open str all_flags mode_w
-    return (Posix.Fd fd)
-  where
-    all_flags  = FD.unionFlags $ optional_flags ++ [open_mode] ++ creat
-
-
-    (creat, mode_w) = case maybe_mode of
-                        Nothing -> ([],0)
-                        Just x  -> ([FD.oCreat], x)
-
-    open_mode = case how of
-                   Posix.ReadOnly  -> FD.oRdonly
-                   Posix.WriteOnly -> FD.oWronly
-                   Posix.ReadWrite -> FD.oRdwr
-
-
--- |Open and optionally create this file. See 'System.Posix.Files'
--- for information on how to use the 'FileMode' type.
---
--- Note that passing @Just x@ as the 4th argument triggers the
--- `oCreat` status flag, which must be set when you pass in `oExcl`
--- to the status flags. Also see the manpage for @open(2)@.
-openFd' :: FilePath
-        -> Posix.OpenMode
-        -> [FD.Flags]               -- ^ status flags of @open(2)@
-        -> Maybe Posix.FileMode  -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist.
-        -> IO Posix.Fd
-openFd' name how optional_flags maybe_mode =
-   withFilePath name $ \str ->
-     throwErrnoPathIfMinus1Retry "openFd" name $
-       open_ str how optional_flags maybe_mode
-
-
--- |Deletes the given file. Raises `eISDIR`
--- if run on a directory. Does not follow symbolic links.
---
--- Throws:
---
---    - `InappropriateType` for wrong file type (directory)
---    - `NoSuchThing` if the file does not exist
---    - `PermissionDenied` if the directory cannot be read
---
--- Notes: calls `unlink`
-deleteFile :: FilePath -> IO ()
-deleteFile = removeLink
-
-
--- |Recreate a symlink.
---
--- In `Overwrite` copy mode only files and empty directories are deleted.
---
--- Safety/reliability concerns:
---
---    * `Overwrite` mode is inherently non-atomic
---
--- Throws:
---
---    - `InvalidArgument` if source file is wrong type (not a symlink)
---    - `PermissionDenied` if output directory cannot be written to
---    - `PermissionDenied` if source directory cannot be opened
---    - `SameFile` if source and destination are the same file
---      (`HPathIOException`)
---
---
--- Throws in `Strict` mode only:
---
---    - `AlreadyExists` if destination already exists
---
--- Throws in `Overwrite` mode only:
---
---    - `UnsatisfiedConstraints` if destination file is non-empty directory
---
--- Notes:
---
---    - calls `symlink`
-recreateSymlink :: FilePath   -- ^ the old symlink file
-                -> FilePath   -- ^ destination file
-                -> Bool       -- ^ fail if destination file exists
-                -> IO ()
-recreateSymlink symsource newsym fail' = do
-  sympoint <- readSymbolicLink symsource
-  case fail' of
-    True  -> pure ()
-    False ->
-      handleIO (\e -> if doesNotExistErrorType  == ioeGetErrorType e then pure () else liftIO . ioError $ e) $ deleteFile newsym
-  createSymbolicLink sympoint newsym
-
-
--- copys files, recreates symlinks, fails on all other types
-install :: FilePath -> FilePath -> Bool -> IO ()
-install from to fail' = do
-  fs <- PF.getSymbolicLinkStatus from
-  decide fs
- where
-  decide fs | PF.isRegularFile fs     = copyFile from to fail'
-            | PF.isSymbolicLink fs    = recreateSymlink from to fail'
-            | otherwise               = ioError $ mkIOError illegalOperationErrorType "install: not a regular file or symlink" Nothing (Just from)
-
-moveFile :: FilePath -> FilePath -> IO ()
-moveFile = rename
-
-
-moveFilePortable :: FilePath -> FilePath -> IO ()
-moveFilePortable from to = do
-  catchErrno [eXDEV] (moveFile from to) $ do
-    copyFile from to True
-    removeFile from
-
-
-catchErrno :: [Errno] -- ^ errno to catch
-           -> IO a    -- ^ action to try, which can raise an IOException
-           -> IO a    -- ^ action to carry out in case of an IOException and
-                      --   if errno matches
-           -> IO a
-catchErrno en a1 a2 =
-  catchIOError a1 $ \e -> do
-    errno <- getErrno
-    if errno `elem` en
-      then a2
-      else ioError e
-
-removeEmptyDirectory :: FilePath -> IO ()
-removeEmptyDirectory = PD.removeDirectory
-
-
--- | Create an 'Unfold' of directory contents.
-unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
-unfoldDirContents = U.bracket (liftIO . openDirStream) (liftIO . closeDirStream) (Unfold step return)
- where
-  {-# INLINE [0] step #-}
-  step dirstream = do
-    (typ, e) <- liftIO $ readDirEnt dirstream
-    return $ if
-      | null e    -> D.Stop
-      | "." == e  -> D.Skip dirstream
-      | ".." == e -> D.Skip dirstream
-      | otherwise -> D.Yield (typ, e) dirstream
-
-
-getDirectoryContentsRecursiveDFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
-                                       => FilePath
-                                       -> S.SerialT m FilePath
-getDirectoryContentsRecursiveDFSUnsafe fp = go ""
- where
-  go cd = flip S.concatMap (S.unfold unfoldDirContents (fp </> cd)) $ \(t, f) ->
-    if | t == FD.dtDir -> go (cd </> f)
-       | otherwise     -> pure (cd </> f)
-
-
-getDirectoryContentsRecursiveUnfold :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath FilePath
-getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""]))
- where
-  {-# INLINE [0] step #-}
-  step (_, Nothing, []) = return D.Stop
-
-  step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
-    (dt, f) <- liftIO $ readDirEnt dirstream
-    if | FD.dtUnknown == dt -> do
-           runIOFinalizer finalizer
-           return $ D.Skip (topdir, Nothing, dirs)
-       | f == "." || f == ".."
-                        -> return $ D.Skip               (topdir, Just (cdir, dirstream, finalizer), dirs)
-       | FD.dtDir == dt -> return $ D.Skip               (topdir, Just (cdir, dirstream, finalizer), (cdir </> f):dirs)
-       | otherwise      -> return $ D.Yield (cdir </> f) (topdir, Just (cdir, dirstream, finalizer), dirs)
-
-  step (topdir, Nothing, dir:dirs) = do
-    (s, f) <- acquire (topdir </> dir)
-    return $ D.Skip (topdir, Just (dir, s, f), dirs)
-
-  acquire dir =
-    withRunInIO $ \run -> mask_ $ run $ do
-        dirstream <- liftIO $ openDirStream dir
-        ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
-        return (dirstream, ref)
-
-getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
-                                       => FilePath
-                                       -> S.SerialT m FilePath
-getDirectoryContentsRecursiveBFSUnsafe = S.unfold getDirectoryContentsRecursiveUnfold
-
-

lib/GHCup/Prelude/Logger.hs

@@ -1,61 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE DataKinds        #-}
-{-# LANGUAGE OverloadedStrings   #-}
-
-{-|
-Module      : GHCup.Utils.Logger
-Description : logger definition
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : portable
-
-Here we define our main logger.
--}
-module GHCup.Prelude.Logger
-  ( module GHCup.Prelude.Logger
-  , module GHCup.Prelude.Logger.Internal
-  )
-where
-
-import           GHCup.Prelude.Logger.Internal
-import           GHCup.Types
-import           GHCup.Types.Optics
-import           GHCup.Utils.Dirs (fromGHCupPath)
-import           GHCup.Prelude.Internal
-import           GHCup.Prelude.File.Search (findFiles)
-import           GHCup.Prelude.File (recycleFile)
-import           GHCup.Prelude.String.QQ
-
-import           Control.Exception.Safe
-import           Control.Monad
-import           Control.Monad.IO.Class
-import           Control.Monad.Reader
-import           Prelude                 hiding ( appendFile )
-import           System.FilePath
-import           System.IO.Error
-import           Text.Regex.Posix
-
-import qualified Data.ByteString               as B
-
-
-
-initGHCupFileLogging :: ( MonadReader env m
-                        , HasDirs env
-                        , MonadIO m
-                        , MonadMask m
-                        ) => m FilePath
-initGHCupFileLogging = do
-  Dirs { logsDir } <- getDirs
-  let logfile = fromGHCupPath logsDir </> "ghcup.log"
-  logFiles <- liftIO $ findFiles
-    (fromGHCupPath logsDir)
-    (makeRegexOpts compExtended
-                   execBlank
-                   ([s|^.*\.log$|] :: B.ByteString)
-    )
-  forM_ logFiles $ hideError doesNotExistErrorType . recycleFile . (fromGHCupPath logsDir </>)
-
-  liftIO $ writeFile logfile ""
-  pure logfile

lib/GHCup/Prelude/Process.hs

@@ -1,25 +0,0 @@
-{-# LANGUAGE CPP #-}
-
-{-|
-Module      : GHCup.Utils.Process
-Description : Process handling
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : portable
--}
-module GHCup.Prelude.Process (
-  executeOut,
-  execLogged,
-  exec,
-  toProcessError,
-) where
-
-
-#if IS_WINDOWS
-import GHCup.Prelude.Process.Windows
-#else
-import GHCup.Prelude.Process.Posix
-#endif
-

lib/GHCup/Prelude/Process/Windows.hs

@@ -1,278 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE FlexibleContexts  #-}
-{-# LANGUAGE DataKinds  #-}
-
-{-|
-Module      : GHCup.Utils.Process.Windows
-Description : Process handling for windows
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : Windows
--}
-module GHCup.Prelude.Process.Windows where
-
-import           GHCup.Utils.Dirs
-import           GHCup.Prelude.File.Search
-import           GHCup.Prelude.Logger.Internal
-import           GHCup.Types
-import           GHCup.Types.Optics
-
-import           Control.Concurrent
-import           Control.DeepSeq
-import           Control.Exception.Safe
-import           Control.Monad
-import           Control.Monad.Reader
-import           Data.List
-import           Foreign.C.Error
-import           GHC.IO.Exception
-import           GHC.IO.Handle
-import           System.Environment
-import           System.FilePath
-import           System.IO
-import           System.Process
-
-import qualified Control.Exception             as EX
-import qualified Data.ByteString               as BS
-import qualified Data.ByteString.Lazy          as BL
-import qualified Data.Map.Strict               as Map
-import qualified Data.Text                     as T
-
-
-
-
-toProcessError :: FilePath
-               -> [FilePath]
-               -> ExitCode
-               -> Either ProcessError ()
-toProcessError exe args exitcode = case exitcode of
-  (ExitFailure xi) -> Left $ NonZeroExit xi exe args
-  ExitSuccess -> Right ()
-
-
--- | @readCreateProcessWithExitCode@ works exactly like 'readProcessWithExitCode' except that it
--- lets you pass 'CreateProcess' giving better flexibility.
---
--- Note that @Handle@s provided for @std_in@, @std_out@, or @std_err@ via the CreateProcess
--- record will be ignored.
---
--- @since 1.2.3.0
-readCreateProcessWithExitCodeBS
-    :: CreateProcess
-    -> BL.ByteString
-    -> IO (ExitCode, BL.ByteString, BL.ByteString) -- ^ exitcode, stdout, stderr
-readCreateProcessWithExitCodeBS cp input = do
-    let cp_opts = cp {
-                    std_in  = CreatePipe,
-                    std_out = CreatePipe,
-                    std_err = CreatePipe
-                  }
-    withCreateProcess_ "readCreateProcessWithExitCodeBS" cp_opts $
-      \mb_inh mb_outh mb_errh ph ->
-        case (mb_inh, mb_outh, mb_errh) of
-          (Just inh, Just outh, Just errh) -> do
-
-            out <- BS.hGetContents outh
-            err <- BS.hGetContents errh
-
-            -- fork off threads to start consuming stdout & stderr
-            withForkWait  (EX.evaluate $ rnf out) $ \waitOut ->
-             withForkWait (EX.evaluate $ rnf err) $ \waitErr -> do
-
-              -- now write any input
-              unless (BL.null input) $
-                ignoreSigPipe $ BL.hPut inh input
-              -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
-              ignoreSigPipe $ hClose inh
-
-              -- wait on the output
-              waitOut
-              waitErr
-
-              hClose outh
-              hClose errh
-
-            -- wait on the process
-            ex <- waitForProcess ph
-            return (ex, BL.fromStrict out, BL.fromStrict err)
-
-          (Nothing,_,_) -> error "readCreateProcessWithExitCodeBS: Failed to get a stdin handle."
-          (_,Nothing,_) -> error "readCreateProcessWithExitCodeBS: Failed to get a stdout handle."
-          (_,_,Nothing) -> error "readCreateProcessWithExitCodeBS: Failed to get a stderr handle."
- where
-  ignoreSigPipe :: IO () -> IO ()
-  ignoreSigPipe = EX.handle $ \e -> case e of
-                                     IOError { ioe_type  = ResourceVanished
-                                             , ioe_errno = Just ioe }
-                                       | Errno ioe == ePIPE -> return ()
-                                     _ -> throwIO e
-  -- wrapper so we can get exceptions with the appropriate function name.
-  withCreateProcess_
-    :: String
-    -> CreateProcess
-    -> (Maybe Handle -> Maybe Handle -> Maybe Handle -> ProcessHandle -> IO a)
-    -> IO a
-  withCreateProcess_ fun c action =
-      EX.bracketOnError (createProcess_ fun c) cleanupProcess
-                       (\(m_in, m_out, m_err, ph) -> action m_in m_out m_err ph)
-
--- | Fork a thread while doing something else, but kill it if there's an
--- exception.
---
--- This is important in the cases above because we want to kill the thread
--- that is holding the Handle lock, because when we clean up the process we
--- try to close that handle, which could otherwise deadlock.
---
-withForkWait :: IO () -> (IO () ->  IO a) -> IO a
-withForkWait async' body = do
-  waitVar <- newEmptyMVar :: IO (MVar (Either SomeException ()))
-  mask $ \restore -> do
-    tid <- forkIO $ try (restore async') >>= putMVar waitVar
-    let wait' = takeMVar waitVar >>= either throwIO return
-    restore (body wait') `EX.onException` killThread tid
-
-
--- | Execute the given command and collect the stdout, stderr and the exit code.
--- The command is run in a subprocess.
-executeOut :: MonadIO m
-           => FilePath          -- ^ command as filename, e.g. 'ls'
-           -> [String]          -- ^ arguments to the command
-           -> Maybe FilePath    -- ^ chdir to this path
-           -> m CapturedProcess
-executeOut path args chdir = do
-  cp <- createProcessWithMingwPath ((proc path args){ cwd = chdir })
-  (exit, out, err) <- liftIO $ readCreateProcessWithExitCodeBS cp ""
-  pure $ CapturedProcess exit out err
-
-
-execLogged :: ( MonadReader env m
-              , HasDirs env
-              , HasLog env
-              , HasSettings env
-              , MonadIO m
-              , MonadThrow m)
-           => FilePath         -- ^ thing to execute
-           -> [String]         -- ^ args for the thing
-           -> Maybe FilePath   -- ^ optionally chdir into this
-           -> FilePath         -- ^ log filename (opened in append mode)
-           -> Maybe [(String, String)] -- ^ optional environment
-           -> m (Either ProcessError ())
-execLogged exe args chdir lfile env = do
-  Dirs {..} <- getDirs
-  logDebug $ T.pack $ "Running " <> exe <> " with arguments " <> show args
-  let stdoutLogfile = fromGHCupPath logsDir </> lfile <> ".stdout.log"
-      stderrLogfile = fromGHCupPath logsDir </> lfile <> ".stderr.log"
-  cp <- createProcessWithMingwPath ((proc exe args)
-    { cwd = chdir
-    , env = env
-    , std_in = CreatePipe
-    , std_out = CreatePipe
-    , std_err = CreatePipe
-    })
-  fmap (toProcessError exe args)
-    $ liftIO
-    $ withCreateProcess cp
-    $ \_ mout merr ph ->
-        case (mout, merr) of
-          (Just cStdout, Just cStderr) -> do
-            withForkWait (tee stdoutLogfile cStdout) $ \waitOut ->
-              withForkWait (tee stderrLogfile cStderr) $ \waitErr -> do
-                waitOut
-                waitErr
-            waitForProcess ph
-          _ -> fail "Could not acquire out/err handle"
-
- where
-  tee :: FilePath -> Handle -> IO ()
-  tee logFile handle' = go
-    where
-      go = do
-        some <- BS.hGetSome handle' 512
-        if BS.null some
-          then pure ()
-          else do
-            void $ BS.appendFile logFile some
-            -- subprocess stdout also goes to stderr for logging
-            void $ BS.hPut stderr some
-            go
-
-
--- | Thin wrapper around `executeFile`.
-exec :: MonadIO m
-     => FilePath       -- ^ thing to execute
-     -> [FilePath]     -- ^ args for the thing
-     -> Maybe FilePath   -- ^ optionally chdir into this
-     -> Maybe [(String, String)] -- ^ optional environment
-     -> m (Either ProcessError ())
-exec exe args chdir env = do
-  -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
-  forM_ (Map.fromList <$> env) $ \cEnv -> do
-    let paths = ["PATH", "Path"]
-        curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
-        newPath = intercalate [searchPathSeparator] curPaths
-    liftIO $ setEnv "PATH" ""
-    liftIO $ setEnv "Path" newPath
-  cp <- createProcessWithMingwPath ((proc exe args) { cwd = chdir, env = env })
-  exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
-  pure $ toProcessError exe args exit_code
-
--- | Like 'exec', except doesn't add msys2 stuff to PATH.
-execNoMinGW :: MonadIO m
-     => FilePath       -- ^ thing to execute
-     -> [FilePath]     -- ^ args for the thing
-     -> Maybe FilePath   -- ^ optionally chdir into this
-     -> Maybe [(String, String)] -- ^ optional environment
-     -> m (Either ProcessError ())
-execNoMinGW exe args chdir env = do
-  -- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/375
-  forM_ (Map.fromList <$> env) $ \cEnv -> do
-    let paths = ["PATH", "Path"]
-        curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
-        newPath = intercalate [searchPathSeparator] curPaths
-    liftIO $ setEnv "PATH" ""
-    liftIO $ setEnv "Path" newPath
-  let cp = (proc exe args) { cwd = chdir, env = env }
-  exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
-  pure $ toProcessError exe args exit_code
-
-
--- | Thin wrapper around `executeFile`.
-execShell :: MonadIO m
-          => FilePath       -- ^ thing to execute
-          -> [FilePath]     -- ^ args for the thing
-          -> Maybe FilePath   -- ^ optionally chdir into this
-          -> Maybe [(String, String)] -- ^ optional environment
-          -> m (Either ProcessError ())
-execShell exe args chdir env = do
-  let cmd = exe <> " " <> concatMap (' ':) args
-  cp <- createProcessWithMingwPath ((shell cmd) { cwd = chdir, env = env })
-  exit_code <- liftIO $ withCreateProcess cp $ \_ _ _ p -> waitForProcess p
-  pure $ toProcessError cmd [] exit_code
-
-
-createProcessWithMingwPath :: MonadIO m
-                          => CreateProcess
-                          -> m CreateProcess
-createProcessWithMingwPath cp = do
-  msys2Dir <- liftIO ghcupMsys2Dir
-  cEnv <- Map.fromList <$> maybe (liftIO getEnvironment) pure (env cp)
-  let mingWPaths = [msys2Dir </> "mingw64" </> "bin"
-                   ,msys2Dir </> "usr" </> "bin"
-                   ]
-      paths = ["PATH", "Path"]
-      curPaths = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
-      newPath = intercalate [searchPathSeparator] (mingWPaths ++ curPaths)
-      envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
-      envWithNewPath = Map.insert "Path" newPath envWithoutPath
-  liftIO $ setEnv "Path" newPath
-  pure $ cp { env = Just $ Map.toList envWithNewPath }
-
-ghcupMsys2Dir :: IO FilePath
-ghcupMsys2Dir =
-  lookupEnv "GHCUP_MSYS2" >>= \case
-    Just fp -> pure fp
-    Nothing -> do
-      baseDir <- liftIO ghcupBaseDir
-      pure (fromGHCupPath baseDir </> "msys64")
-

lib/GHCup/Prompts.hs

@@ -1,28 +0,0 @@
-{-# 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

@@ -1,284 +0,0 @@
-{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-
-{-|
-Module      : GHCup.Stack
-Description : GHCup installation functions for Stack
-Copyright   : (c) Julian Ospald, 2020
-License     : LGPL-3.0
-Maintainer  : hasufell@hasufell.de
-Stability   : experimental
-Portability : portable
--}
-module GHCup.Stack where
-
-import           GHCup.Download
-import           GHCup.Errors
-import           GHCup.Types
-import           GHCup.Types.JSON               ( )
-import           GHCup.Types.Optics
-import           GHCup.Utils
-import           GHCup.Prelude
-import           GHCup.Prelude.File
-import           GHCup.Prelude.Logger
-
-import           Codec.Archive                  ( ArchiveResult )
-import           Control.Applicative
-import           Control.Exception.Safe
-import           Control.Monad
-#if !MIN_VERSION_base(4,13,0)
-import           Control.Monad.Fail             ( MonadFail )
-#endif
-import           Control.Monad.Reader
-import           Control.Monad.Trans.Resource
-                                         hiding ( throwM )
-import           Data.Either
-import           Data.List
-import           Data.Maybe
-import           Data.Versions                hiding ( patch )
-import           Haskus.Utils.Variant.Excepts
-import           Optics
-import           Prelude                 hiding ( abs
-                                                , writeFile
-                                                )
-import           Safe                    hiding ( at )
-import           System.FilePath
-import           System.IO.Error
-
-import qualified Data.Text                     as T
-
-
-
-    --------------------
-    --[ Installation ]--
-    --------------------
-
-
--- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
--- creates a default @stack -> stack-x.y.z.q@ symlink for
--- the latest installed version.
-installStackBin :: ( MonadMask m
-                   , MonadCatch m
-                   , MonadReader env m
-                   , HasDirs env
-                   , HasSettings env
-                   , HasPlatformReq env
-                   , HasGHCupInfo env
-                   , HasLog env
-                   , MonadResource m
-                   , MonadIO m
-                   , MonadUnliftIO m
-                   , MonadFail m
-                   )
-                => Version
-                -> InstallDir
-                -> Bool            -- ^ Force install
-                -> Excepts
-                     '[ AlreadyInstalled
-                      , CopyError
-                      , DigestError
-                      , ContentLengthError
-                      , GPGError
-                      , DownloadFailed
-                      , NoDownload
-                      , NotInstalled
-                      , UnknownArchive
-                      , TarDirDoesNotExist
-                      , ArchiveResult
-                      , FileAlreadyExistsError
-                      ]
-                     m
-                     ()
-installStackBin ver installDir forceInstall = do
-  dlinfo <- liftE $ getDownloadInfo Stack ver
-  installStackBindist dlinfo ver installDir forceInstall
-
-
--- | Like 'installStackBin', except takes the 'DownloadInfo' as
--- argument instead of looking it up from 'GHCupDownloads'.
-installStackBindist :: ( MonadMask m
-                       , MonadCatch m
-                       , MonadReader env m
-                       , HasPlatformReq env
-                       , HasDirs env
-                       , HasSettings env
-                       , HasLog env
-                       , MonadResource m
-                       , MonadIO m
-                       , MonadUnliftIO m
-                       , MonadFail m
-                       )
-                    => DownloadInfo
-                    -> Version
-                    -> InstallDir
-                    -> Bool           -- ^ Force install
-                    -> Excepts
-                         '[ AlreadyInstalled
-                          , CopyError
-                          , DigestError
-                          , ContentLengthError
-                          , GPGError
-                          , DownloadFailed
-                          , NoDownload
-                          , NotInstalled
-                          , UnknownArchive
-                          , TarDirDoesNotExist
-                          , ArchiveResult
-                          , FileAlreadyExistsError
-                          ]
-                         m
-                         ()
-installStackBindist dlinfo ver installDir forceInstall = do
-  lift $ logDebug $ "Requested to install stack version " <> prettyVer ver
-
-  PlatformRequest {..} <- lift getPlatformReq
-  Dirs {..} <- lift getDirs
-
-  regularStackInstalled <- lift $ stackInstalled ver
-
-  if
-    | not forceInstall
-    , regularStackInstalled
-    , GHCupInternal <- installDir -> do
-        throwE $ AlreadyInstalled Stack ver
-
-    | forceInstall
-    , regularStackInstalled
-    , GHCupInternal <- installDir -> do
-        lift $ logInfo "Removing the currently installed version of Stack first!"
-        liftE $ rmStackVer ver
-
-    | otherwise -> pure ()
-
-  -- download (or use cached version)
-  dl <- liftE $ downloadCached dlinfo Nothing
-
-  -- unpack
-  tmpUnpack <- lift withGHCupTmpDir
-  liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
-  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform (fromGHCupPath tmpUnpack)
-
-  -- the subdir of the archive where we do the work
-  workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
-
-  case installDir of
-    IsolateDir isoDir -> do                 -- isolated install
-      lift $ logInfo $ "isolated installing Stack to " <> T.pack isoDir
-      liftE $ installStackUnpacked workdir (IsolateDirResolved isoDir) ver forceInstall
-    GHCupInternal -> do                     -- regular install
-      liftE $ installStackUnpacked workdir (GHCupBinDir binDir) ver forceInstall
-
-
--- | Install an unpacked stack distribution.
-installStackUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m)
-              => GHCupPath      -- ^ Path to the unpacked stack bindist (where the executable resides)
-              -> InstallDirResolved
-              -> Version
-              -> Bool          -- ^ Force install
-              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
-installStackUnpacked path installDir ver forceInstall = do
-  lift $ logInfo "Installing stack"
-  let stackFile = "stack"
-  liftIO $ createDirRecursive' (fromInstallDir installDir)
-  let destFileName = stackFile
-                     <> (case installDir of
-                          IsolateDirResolved _ -> ""
-                          _ -> ("-" <>) .  T.unpack . prettyVer $ ver
-                        )
-                     <> exeExt
-      destPath = fromInstallDir installDir </> destFileName
-
-  copyFileE
-    (fromGHCupPath path </> stackFile <> exeExt)
-    destPath
-    (not forceInstall)
-  lift $ chmod_755 destPath
-
-
-
-    -----------------
-    --[ Set stack ]--
-    -----------------
-
-
--- | Set the @~\/.ghcup\/bin\/stack@ symlink.
-setStack :: ( MonadMask m
-            , MonadReader env m
-            , HasDirs env
-            , HasLog env
-            , MonadThrow m
-            , MonadFail m
-            , MonadIO m
-            , MonadUnliftIO m
-            )
-         => Version
-         -> Excepts '[NotInstalled] m ()
-setStack ver = do
-  let targetFile = "stack-" <> T.unpack (prettyVer ver) <> exeExt
-
-  -- symlink destination
-  Dirs {..} <- lift getDirs
-
-  whenM (liftIO $ not <$> doesFileExist (binDir </> targetFile))
-    $ throwE
-    $ NotInstalled Stack (GHCTargetVersion Nothing ver)
-
-  let stackbin = binDir </> "stack" <> exeExt
-
-  lift $ createLink targetFile stackbin
-
-  liftIO (isShadowed stackbin) >>= \case
-    Nothing -> pure ()
-    Just pa -> lift $ logWarn $ T.pack $ prettyHFError (ToolShadowed Cabal pa stackbin ver)
-
-  pure ()
-
-
-unsetStack :: ( MonadMask m
-              , MonadReader env m
-              , HasDirs env
-              , MonadIO m)
-           => m ()
-unsetStack = do
-  Dirs {..} <- getDirs
-  let stackbin = binDir </> "stack" <> exeExt
-  hideError doesNotExistErrorType $ rmLink stackbin
-
-
-    ----------------
-    --[ Rm stack ]--
-    ----------------
-
--- | Delete a stack version. Will try to fix the @stack@ symlink
--- after removal (e.g. setting it to an older version).
-rmStackVer :: ( MonadMask m
-              , MonadReader env m
-              , HasDirs env
-              , MonadThrow m
-              , HasLog env
-              , MonadIO m
-              , MonadFail m
-              , MonadCatch m
-              , MonadUnliftIO m
-              )
-           => Version
-           -> Excepts '[NotInstalled] m ()
-rmStackVer ver = do
-  whenM (lift $ fmap not $ stackInstalled ver) $ throwE (NotInstalled Stack (GHCTargetVersion Nothing ver))
-
-  sSet      <- lift stackSet
-
-  Dirs {..} <- lift getDirs
-
-  let stackFile = "stack-" <> T.unpack (prettyVer ver) <> exeExt
-  lift $ hideError doesNotExistErrorType $ recycleFile (binDir </> stackFile)
-
-  when (Just ver == sSet) $ do
-    sVers <- lift $ fmap rights getInstalledStacks
-    case headMay . reverse . sort $ sVers of
-      Just latestver -> setStack latestver
-      Nothing        -> lift $ rmLink (binDir </> "stack" <> exeExt)

lib/GHCup/Types.hs

@@ -26,7 +26,8 @@ module GHCup.Types
   )
   where
 
-import {-# SOURCE #-} GHCup.Utils.Dirs          ( fromGHCupPath, GHCupPath )
+import {-# SOURCE #-} GHCup.Utils.Dirs          ( fromGHCupPath )
+import {-# SOURCE #-} GHCup.Utils.Dirs          ( GHCupPath )
 
 import           Control.DeepSeq                ( NFData, rnf )
 import           Data.Map.Strict                ( Map )
@@ -35,7 +36,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(..) )
@@ -138,7 +139,6 @@ data VersionInfo = VersionInfo
   { _viTags        :: [Tag]              -- ^ version specific tag
   , _viChangeLog   :: Maybe URI
   , _viSourceDL    :: Maybe DownloadInfo -- ^ source tarball
-  , _viTestDL      :: Maybe DownloadInfo -- ^ test tarball
   , _viArch        :: ArchitectureSpec   -- ^ descend for binary downloads per arch
   -- informative messages
   , _viPostInstall :: Maybe Text
@@ -263,7 +263,6 @@ data DownloadInfo = DownloadInfo
   { _dlUri    :: URI
   , _dlSubdir :: Maybe TarDir
   , _dlHash   :: Text
-  , _dlCSize  :: Maybe Integer
   }
   deriving (Eq, Ord, GHC.Generic, Show)
 
@@ -299,16 +298,10 @@ 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
@@ -317,19 +310,17 @@ 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 Nothing Nothing
+defaultUserSettings = UserSettings 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
@@ -338,24 +329,22 @@ 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
@@ -364,7 +353,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
     , uKeyBindings = Just ukb
     , uUrlSource = Just urlSource
     , uGPGSetting = Just gpgSetting
-    , uPlatformOverride = platformOverride
   }
 
 data UserKeyBindings = UserKeyBindings
@@ -420,9 +408,6 @@ data AppState = AppState
 
 instance NFData AppState
 
-fromAppState :: AppState -> LeanAppState
-fromAppState AppState {..} = LeanAppState {..}
-
 data LeanAppState = LeanAppState
   { settings :: Settings
   , dirs :: Dirs
@@ -434,18 +419,16 @@ instance NFData LeanAppState
 
 
 data Settings = Settings
-  { 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
+  { 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
   }
   deriving (Show, GHC.Generic)
 
@@ -453,19 +436,18 @@ defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
+defaultSettings = Settings False defaultMetaCache False Never Curl False GHCupURL False GPGNone False
 
 instance NFData Settings
 
 data Dirs = Dirs
-  { baseDir    :: GHCupPath
-  , binDir     :: FilePath
-  , cacheDir   :: GHCupPath
-  , logsDir    :: GHCupPath
-  , confDir    :: GHCupPath
-  , dbDir      :: GHCupPath
+  { baseDir  :: GHCupPath
+  , binDir   :: FilePath
+  , cacheDir :: GHCupPath
+  , logsDir  :: GHCupPath
+  , confDir  :: GHCupPath
+  , dbDir    :: GHCupPath
   , recycleDir :: GHCupPath -- mainly used on windows
-  , tmpDir     :: GHCupPath
   }
   deriving (Show, GHC.Generic)
 
@@ -633,7 +615,15 @@ 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,14 +647,3 @@ fromInstallDir :: InstallDirResolved -> FilePath
 fromInstallDir (IsolateDirResolved fp) = fp
 fromInstallDir (GHCupDir fp) = fromGHCupPath fp
 fromInstallDir (GHCupBinDir fp) = fp
-
-
-isSafeDir :: InstallDirResolved -> Bool
-isSafeDir (IsolateDirResolved _) = False
-isSafeDir (GHCupDir _)           = True
-isSafeDir (GHCupBinDir _)        = False
-
-type PromptQuestion = Text
-
-data PromptResponse = PromptYes | PromptNo
-  deriving (Show, Eq)

lib/GHCup/Types/JSON.hs

@@ -23,7 +23,7 @@ module GHCup.Types.JSON where
 
 import           GHCup.Types
 import           GHCup.Types.JSON.Utils
-import           GHCup.Prelude.MegaParsec
+import           GHCup.Utils.MegaParsec
 
 import           Control.Applicative            ( (<|>) )
 import           Data.Aeson              hiding (Key)
@@ -43,7 +43,6 @@ 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
@@ -57,7 +56,6 @@ 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"
@@ -81,6 +79,37 @@ instance FromJSON Tag where
 instance ToJSON URI where
   toJSON = toJSON . E.decodeUtf8With E.lenientDecode . serializeURIRef'
 
+instance FromJSON URLSource where
+  parseJSON v =
+        parseGHCupURL v
+    <|> parseOwnSourceLegacy v
+    <|> parseOwnSourceNew1 v
+    <|> parseOwnSourceNew2 v
+    <|> parseOwnSpec v
+    <|> legacyParseAddSource v
+    <|> newParseAddSource v
+   where
+    parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
+      r :: URI <- o .: "OwnSource"
+      pure (OwnSource [Right r])
+    parseOwnSourceNew1 = withObject "URLSource" $ \o -> do
+      r :: [URI] <- o .: "OwnSource"
+      pure (OwnSource (fmap Right r))
+    parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
+      r :: [Either GHCupInfo URI] <- o .: "OwnSource"
+      pure (OwnSource r)
+    parseOwnSpec = withObject "URLSource" $ \o -> do
+      r :: GHCupInfo <- o .: "OwnSpec"
+      pure (OwnSpec r)
+    parseGHCupURL = withObject "URLSource" $ \o -> do
+      _ :: [Value] <- o .: "GHCupURL"
+      pure GHCupURL
+    legacyParseAddSource = withObject "URLSource" $ \o -> do
+      r :: Either GHCupInfo URI <- o .: "AddSource"
+      pure (AddSource [r])
+    newParseAddSource = withObject "URLSource" $ \o -> do
+      r :: [Either GHCupInfo URI] <- o .: "AddSource"
+      pure (AddSource r)
 
 instance FromJSON URI where
   parseJSON = withText "URL" $ \t ->
@@ -320,40 +349,7 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupI
 deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
-deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
-deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
-
-instance FromJSON URLSource where
-  parseJSON v =
-        parseGHCupURL v
-    <|> parseOwnSourceLegacy v
-    <|> parseOwnSourceNew1 v
-    <|> parseOwnSourceNew2 v
-    <|> parseOwnSpec v
-    <|> legacyParseAddSource v
-    <|> newParseAddSource v
-   where
-    parseOwnSourceLegacy = withObject "URLSource" $ \o -> do
-      r :: URI <- o .: "OwnSource"
-      pure (OwnSource [Right r])
-    parseOwnSourceNew1 = withObject "URLSource" $ \o -> do
-      r :: [URI] <- o .: "OwnSource"
-      pure (OwnSource (fmap Right r))
-    parseOwnSourceNew2 = withObject "URLSource" $ \o -> do
-      r :: [Either GHCupInfo URI] <- o .: "OwnSource"
-      pure (OwnSource r)
-    parseOwnSpec = withObject "URLSource" $ \o -> do
-      r :: GHCupInfo <- o .: "OwnSpec"
-      pure (OwnSpec r)
-    parseGHCupURL = withObject "URLSource" $ \o -> do
-      _ :: [Value] <- o .: "GHCupURL"
-      pure GHCupURL
-    legacyParseAddSource = withObject "URLSource" $ \o -> do
-      r :: Either GHCupInfo URI <- o .: "AddSource"
-      pure (AddSource [r])
-    newParseAddSource = withObject "URLSource" $ \o -> do
-      r :: [Either GHCupInfo URI] <- o .: "AddSource"
-      pure (AddSource r)
-
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
 
+deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
+deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key

lib/GHCup/Utils.hs

@@ -23,18 +23,18 @@ module GHCup.Utils
   ( module GHCup.Utils.Dirs
   , module GHCup.Utils
 #if defined(IS_WINDOWS)
-  , module GHCup.Prelude.Windows
+  , module GHCup.Utils.Windows
 #else
-  , module GHCup.Prelude.Posix
+  , module GHCup.Utils.Posix
 #endif
   )
 where
 
 
 #if defined(IS_WINDOWS)
-import GHCup.Prelude.Windows
+import GHCup.Utils.Windows
 #else
-import GHCup.Prelude.Posix
+import GHCup.Utils.Posix
 #endif
 import           GHCup.Download
 import           GHCup.Errors
@@ -42,13 +42,11 @@ import           GHCup.Types
 import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Dirs
-import           GHCup.Version
-import           GHCup.Prelude
-import           GHCup.Prelude.File
-import           GHCup.Prelude.Logger.Internal
-import           GHCup.Prelude.MegaParsec
-import           GHCup.Prelude.Process
-import           GHCup.Prelude.String.QQ
+import           GHCup.Utils.File
+import           GHCup.Utils.Logger
+import           GHCup.Utils.MegaParsec
+import           GHCup.Utils.Prelude
+import           GHCup.Utils.String.QQ
 
 import           Codec.Archive           hiding ( Directory )
 import           Control.Applicative
@@ -61,7 +59,6 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                          hiding ( throwM )
 import           Control.Monad.IO.Unlift        ( MonadUnliftIO( withRunInIO ) )
-import           Data.Char                      ( isHexDigit )
 import           Data.Bifunctor                 ( first )
 import           Data.ByteString                ( ByteString )
 import           Data.Either
@@ -78,7 +75,6 @@ import           Safe
 import           System.FilePath
 import           System.IO.Error
 import           Text.Regex.Posix
-import           Text.PrettyPrint.HughesPJClass (prettyShow)
 import           URI.ByteString
 
 import qualified Codec.Compression.BZip        as BZip
@@ -93,7 +89,6 @@ import qualified Data.List.NonEmpty            as NE
 import qualified Streamly.Prelude              as S
 import Control.DeepSeq (force)
 import GHC.IO (evaluate)
-import System.Environment (getEnvironment, setEnv)
 
 
 -- $setup
@@ -104,14 +99,14 @@ import System.Environment (getEnvironment, setEnv)
 -- >>> import System.Directory
 -- >>> import URI.ByteString
 -- >>> import qualified Data.Text as T
--- >>> import GHCup.Prelude
+-- >>> import GHCup.Utils.Prelude
 -- >>> import GHCup.Download
 -- >>> import GHCup.Version
 -- >>> import GHCup.Errors
 -- >>> import GHCup.Types
 -- >>> import GHCup.Types.Optics
 -- >>> import Optics
--- >>> import GHCup.Prelude.Version.QQ
+-- >>> import GHCup.Utils.Version.QQ
 -- >>> import qualified Data.Text.Encoding as E
 -- >>> import Control.Monad.Reader
 -- >>> import Haskus.Utils.Variant.Excepts
@@ -968,28 +963,11 @@ make :: ( MonadThrow m
      => [String]
      -> Maybe FilePath
      -> m (Either ProcessError ())
-make args workdir = make' args workdir "ghc-make" Nothing
-
-
--- | Calls gmake if it exists in PATH, otherwise make.
-make' :: ( MonadThrow m
-         , MonadIO m
-         , MonadReader env m
-         , HasDirs env
-         , HasLog env
-         , HasSettings env
-         )
-      => [String]
-      -> Maybe FilePath
-      -> FilePath         -- ^ log filename (opened in append mode)
-      -> Maybe [(String, String)] -- ^ optional environment
-      -> m (Either ProcessError ())
-make' args workdir logfile menv = do
+make args workdir = do
   spaths    <- liftIO getSearchPath
   has_gmake <- isJust <$> liftIO (searchPath spaths "gmake")
   let mymake = if has_gmake then "gmake" else "make"
-  execLogged mymake args workdir logfile menv
-
+  execLogged mymake args workdir "ghc-make" Nothing
 
 makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
         => [String]
@@ -1041,28 +1019,6 @@ applyPatch patch ddir = do
     !? PatchFailed
 
 
-applyAnyPatch :: ( MonadReader env m
-                 , HasDirs env
-                 , HasLog env
-                 , HasSettings env
-                 , MonadUnliftIO m
-                 , MonadCatch m
-                 , MonadResource m
-                 , MonadThrow m
-                 , MonadMask m
-                 , MonadIO m)
-              => Maybe (Either FilePath [URI])
-              -> FilePath
-              -> 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 Nothing tmpUnpack Nothing False
-    liftE $ applyPatch patch workdir
-
-
 -- | https://gitlab.haskell.org/ghc/ghc/-/issues/17353
 darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
                    => Platform
@@ -1115,8 +1071,7 @@ runBuildAction bdir action = do
 
 -- | Clean up the given directory if the action fails,
 -- depending on the Settings.
-cleanUpOnError :: forall e m a env .
-                  ( MonadReader env m
+cleanUpOnError :: ( MonadReader env m
                   , HasDirs env
                   , HasSettings env
                   , MonadIO m
@@ -1179,6 +1134,97 @@ getVersionInfo v' tool =
     )
 
 
+-- | The file extension for executables.
+exeExt :: String
+exeExt
+  | isWindows = ".exe"
+  | otherwise = ""
+
+-- | The file extension for executables.
+exeExt' :: ByteString
+exeExt'
+  | isWindows = ".exe"
+  | otherwise = ""
+
+
+
+
+-- | On unix, we can use symlinks, so we just get the
+-- symbolic link target.
+--
+-- On windows, we have to emulate symlinks via shims,
+-- see 'createLink'.
+getLinkTarget :: FilePath -> IO FilePath
+getLinkTarget fp
+  | isWindows = do
+      content <- readFile (dropExtension fp <.> "shim")
+      [p] <- pure . filter ("path = " `isPrefixOf`) . lines $ content
+      pure $ stripNewline $ dropPrefix "path = " p
+  | otherwise = getSymbolicLinkTarget fp
+
+
+-- | Checks whether the path is a link.
+pathIsLink :: FilePath -> IO Bool
+pathIsLink fp
+  | isWindows = doesPathExist (dropExtension fp <.> "shim")
+  | otherwise = pathIsSymbolicLink fp
+
+
+rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
+rmLink fp
+  | isWindows = do
+      hideError doesNotExistErrorType . recycleFile $ fp
+      hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
+  | otherwise = hideError doesNotExistErrorType . recycleFile $ fp
+
+
+-- | Creates a symbolic link on unix and a fake symlink on windows for
+-- executables, which:
+--     1. is a shim exe
+--     2. has a corresponding .shim file in the same directory that
+--        contains the target
+--
+-- This overwrites previously existing files.
+--
+-- On windows, this requires that 'ensureGlobalTools' was run beforehand.
+createLink :: ( MonadMask m
+              , MonadThrow m
+              , HasLog env
+              , MonadIO m
+              , MonadReader env m
+              , HasDirs env
+              , MonadUnliftIO m
+              , MonadFail m
+              )
+           => FilePath      -- ^ path to the target executable
+           -> FilePath      -- ^ path to be created
+           -> m ()
+createLink link exe
+  | isWindows = do
+      dirs <- getDirs
+      let shimGen = fromGHCupPath (cacheDir dirs) </> "gs.exe"
+
+      let shim = dropExtension exe <.> "shim"
+          -- For hardlinks, link needs to be absolute.
+          -- If link is relative, it's relative to the target exe.
+          -- Note that (</>) drops lhs when rhs is absolute.
+          fullLink = takeDirectory exe </> link
+          shimContents = "path = " <> fullLink
+
+      logDebug $ "rm -f " <> T.pack exe
+      rmLink exe
+
+      logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
+      liftIO $ copyFile shimGen exe False
+      liftIO $ writeFile shim shimContents
+  | otherwise = do
+      logDebug $ "rm -f " <> T.pack exe
+      hideError doesNotExistErrorType $ recycleFile exe
+
+      logDebug $ "ln -s " <> T.pack link <> " " <> T.pack exe
+      liftIO $ createFileLink link exe
+
+
 ensureGlobalTools :: ( MonadMask m
                      , MonadThrow m
                      , HasLog env
@@ -1190,7 +1236,7 @@ ensureGlobalTools :: ( MonadMask m
                      , MonadUnliftIO m
                      , MonadFail m
                      )
-                  => Excepts '[GPGError, DigestError, ContentLengthError, DownloadFailed, NoDownload] m ()
+                  => Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
 ensureGlobalTools
   | isWindows = do
       (GHCupInfo _ _ gTools) <- lift getGHCupInfo
@@ -1202,24 +1248,22 @@ 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, ContentLengthError, DownloadFailed] $ dl
-        ) `catchE` liftE @'[GPGError, DigestError, ContentLengthError, DownloadFailed] dl
+          liftE @'[GPGError, DigestError , DownloadFailed] $ dl
+        ) `catchE` liftE @'[GPGError, DigestError , DownloadFailed] dl
   | otherwise = pure ()
 
 
 -- | Ensure ghcup directory structure exists.
 ensureDirectories :: Dirs -> IO ()
-ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir dbDir tmpDir) = do
+ensureDirectories (Dirs baseDir binDir cacheDir logsDir confDir trashDir dbDir) = do
   createDirRecursive' (fromGHCupPath baseDir)
   createDirRecursive' (fromGHCupPath baseDir </> "ghc")
-  createDirRecursive' (fromGHCupPath baseDir </> "hls")
   createDirRecursive' binDir
   createDirRecursive' (fromGHCupPath cacheDir)
   createDirRecursive' (fromGHCupPath logsDir)
   createDirRecursive' (fromGHCupPath confDir)
   createDirRecursive' (fromGHCupPath trashDir)
   createDirRecursive' (fromGHCupPath dbDir)
-  createDirRecursive' (fromGHCupPath tmpDir)
   pure ()
 
 
@@ -1270,78 +1314,3 @@ getInstalledFiles t v' = hideErrorDef [doesNotExistErrorType] Nothing $ do
   pure (Just $ lines c)
 
 
--- | Warn if the installed and set HLS is not compatible with the installed and
--- set GHC version.
-warnAboutHlsCompatibility :: ( MonadReader env m
-                             , HasDirs env
-                             , HasLog env
-                             , MonadThrow m
-                             , MonadCatch m
-                             , MonadIO m
-                             )
-                          => m ()
-warnAboutHlsCompatibility = do
-  supportedGHC <- hlsGHCVersions
-  currentGHC   <- fmap _tvVersion <$> ghcSet Nothing
-  currentHLS   <- hlsSet
-
-  case (currentGHC, currentHLS) of
-    (Just gv, Just hv) | gv `notElem` supportedGHC -> do
-      logWarn $
-        "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 ()
-
-
-
-addToPath :: FilePath
-          -> Bool         -- ^ if False will prepend
-          -> IO [(String, String)]
-addToPath path append = do
- cEnv <- Map.fromList <$> getEnvironment
- let paths          = ["PATH", "Path"]
-     curPaths       = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
-     {- HLINT ignore "Redundant bracket" -}
-     newPath        = intercalate [searchPathSeparator] (if append then (curPaths ++ [path]) else (path : curPaths))
-     envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
-     pathVar        = if isWindows then "Path" else "PATH"
-     envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
- liftIO $ setEnv pathVar newPath
- return envWithNewPath
-
-
-    -----------
-    --[ Git ]--
-    -----------
-
-
-
-isCommitHash :: String -> Bool
-isCommitHash str' = let hex = all isHexDigit str'
-                        len = length str'
-                    in hex && len == 40
-
-
-gitOut :: (MonadReader env m, HasLog env, MonadIO m) => [String] -> FilePath -> Excepts '[ProcessError] m T.Text
-gitOut args dir = do
-  CapturedProcess {..} <- lift $ executeOut "git" args (Just dir)
-  case _exitCode of
-    ExitSuccess   -> pure $ T.pack $ stripNewlineEnd $ T.unpack $ decUTF8Safe' _stdOut
-    ExitFailure c -> do
-      let pe = NonZeroExit c "git" args
-      lift $ logDebug $ T.pack (prettyHFError pe)
-      throwE pe
-
-processBranches :: T.Text -> [String]
-processBranches str' = let lines'   = lines (T.unpack str')
-                           words'   = fmap words lines'
-                           refs     = catMaybes $ fmap (`atMay` 1) words'
-                           branches = catMaybes $ fmap (stripPrefix "refs/heads/") $ filter (isPrefixOf "refs/heads/") refs
-                       in branches
-

lib/GHCup/Utils.hs-boot

@@ -0,0 +1,4 @@
+module GHCup.Utils where
+
+getLinkTarget :: FilePath -> IO FilePath
+pathIsLink :: FilePath -> IO Bool

lib/GHCup/Utils/Dirs.hs

@@ -107,15 +107,11 @@ import           GHCup.Errors
 import           GHCup.Types
 import           GHCup.Types.JSON               ( )
 import           GHCup.Types.Optics
-import           GHCup.Prelude.MegaParsec
-import           GHCup.Prelude.File.Search
-import           GHCup.Prelude.String.QQ
-import           GHCup.Prelude.Logger.Internal (logWarn, logDebug)
-#if defined(IS_WINDOWS)
-import           GHCup.Prelude.Windows ( isWindows )
-#else
-import           GHCup.Prelude.Posix   ( isWindows )
-#endif
+import           GHCup.Utils.MegaParsec
+import           GHCup.Utils.Logger
+import           GHCup.Utils.Prelude
+import           GHCup.Utils.File.Common
+import           GHCup.Utils.String.QQ
 
 import           Control.DeepSeq (NFData, rnf)
 import           Control.Exception.Safe
@@ -139,6 +135,7 @@ import           System.Directory hiding ( removeDirectory
                                          )
 import qualified System.Directory              as SD
 
+import           System.DiskSpace
 import           System.Environment
 import           System.FilePath
 import           System.IO.Temp
@@ -148,7 +145,7 @@ import qualified Data.ByteString               as BS
 import qualified Data.Text                     as T
 import qualified Data.Yaml.Aeson               as Y
 import qualified Text.Megaparsec               as MP
-import System.IO.Error (ioeGetErrorType)
+import Control.Concurrent (threadDelay)
 
 
 
@@ -177,7 +174,7 @@ createTempGHCupDirectory (GHCupPath gp) d = GHCupPath <$> createTempDirectory gp
 
 getGHCupTmpDirs :: IO [GHCupPath]
 getGHCupTmpDirs = do
-  tmpdir <- fromGHCupPath <$> ghcupTMPDir
+  tmpdir <- getCanonicalTemporaryDirectory
   ghcup_dirs <- handleIO (\_ -> pure []) $ findFiles
     tmpdir
     (makeRegexOpts compExtended
@@ -326,25 +323,6 @@ ghcupRecycleDir :: IO GHCupPath
 ghcupRecycleDir = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "trash"))
 
 
--- | Defaults to '~/.ghcup/tmp.
---
--- If 'GHCUP_USE_XDG_DIRS' is set (to anything),
--- then uses 'XDG_CACHE_HOME/ghcup/tmp as per xdg spec.
-ghcupTMPDir :: IO GHCupPath
-ghcupTMPDir
-  | isWindows = ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "tmp"))
-  | otherwise = do
-      xdg <- useXDG
-      if xdg
-        then do
-          bdir <- lookupEnv "XDG_CACHE_HOME" >>= \case
-            Just r  -> pure r
-            Nothing -> do
-              home <- liftIO getHomeDirectory
-              pure (home </> ".cache")
-          pure (GHCupPath (bdir </> "ghcup" </> "tmp"))
-        else ghcupBaseDir <&> (\(GHCupPath gp) -> GHCupPath (gp </> "tmp"))
-
 
 getAllDirs :: IO Dirs
 getAllDirs = do
@@ -354,7 +332,6 @@ getAllDirs = do
   logsDir    <- ghcupLogsDir
   confDir    <- ghcupConfigDir
   recycleDir <- ghcupRecycleDir
-  tmpDir     <- ghcupTMPDir
   dbDir      <- ghcupDbDir
   pure Dirs { .. }
 
@@ -373,15 +350,10 @@ ghcupConfigFile :: (MonadIO m)
                 => Excepts '[JSONError] m UserSettings
 ghcupConfigFile = do
   filepath <- getConfigFilePath
-  contents <- liftIO $ handleIO (\e -> if NoSuchThing == ioeGetErrorType e then pure Nothing else liftIO $ ioError e) $ Just <$> BS.readFile filepath
+  contents <- liftIO $ handleIO' NoSuchThing (\_ -> pure Nothing) $ Just <$> BS.readFile filepath
   case contents of
       Nothing -> pure defaultUserSettings
-      Just contents' -> liftE
-        . veitherToExcepts @_ @'[JSONError]
-        . either (VLeft . V) VRight
-        . first (JSONDecodeError . displayException)
-        . Y.decodeEither'
-        $ contents'
+      Just contents' -> lE' JSONDecodeError . first displayException . Y.decodeEither' $ contents'
 
 
     -------------------------
@@ -418,12 +390,6 @@ parseGHCupHLSDir :: MonadThrow m => FilePath -> m Version
 parseGHCupHLSDir (T.pack -> fp) =
   throwEither $ MP.parse version' "" fp
 
--- TODO: inlined from GHCup.Prelude
-throwEither :: (Exception a, MonadThrow m) => Either a b -> m b
-throwEither a = case a of
-  Left  e -> throwM e
-  Right r -> pure r
-
 -- | ~/.ghcup/hls by default, for new-style installs.
 ghcupHLSBaseDir :: (MonadReader env m, HasDirs env) => m GHCupPath
 ghcupHLSBaseDir = do
@@ -439,7 +405,6 @@ ghcupHLSDir ver = do
   let verdir = T.unpack $ prettyVer ver
   pure (basedir `appendGHCupPath` verdir)
 
-
 mkGhcupTmpDir :: ( MonadReader env m
                  , HasDirs env
                  , MonadUnliftIO m
@@ -450,8 +415,29 @@ mkGhcupTmpDir :: ( MonadReader env m
                  , MonadIO m)
               => m GHCupPath
 mkGhcupTmpDir = GHCupPath <$> do
-  Dirs { tmpDir } <- getDirs
-  liftIO $ createTempDirectory (fromGHCupPath tmpDir) "ghcup"
+  tmpdir <- liftIO getCanonicalTemporaryDirectory
+
+  let minSpace = 5000 -- a rough guess, aight?
+  space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
+  when (maybe False (toBytes minSpace >) space) $ do
+    logWarn ("Possibly insufficient disk space on "
+      <> T.pack tmpdir
+      <> ". At least "
+      <> T.pack (show minSpace)
+      <> " MB are recommended, but only "
+      <> toMB (fromJust space)
+      <> " are free. Consider freeing up disk space or setting TMPDIR env variable.")
+    logWarn
+      "...waiting for 10 seconds before continuing anyway, you can still abort..."
+    liftIO $ threadDelay 10000000 -- give the user a sec to intervene
+
+  liftIO $ createTempDirectory tmpdir "ghcup"
+ where
+  toBytes mb = mb * 1024 * 1024
+  toMB b = T.pack $ show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
+  truncate' :: Double -> Int -> Double
+  truncate' x n = fromIntegral (floor (x * t) :: Integer) / t
+      where t = 10^n
 
 
 withGHCupTmpDir :: ( MonadReader env m
@@ -465,22 +451,15 @@ withGHCupTmpDir :: ( MonadReader env m
                    , MonadMask m
                    , MonadIO m)
                 => m GHCupPath
-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))
+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)))
+            . rmPathForcibly
+            $ fp))
 
 
 
@@ -543,4 +522,3 @@ removePathForcibly (GHCupPath fp) = SD.removePathForcibly fp
 
 
 
-

lib/GHCup/Utils/File.hs

@@ -0,0 +1,160 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE FlexibleContexts    #-}
+{-# LANGUAGE FlexibleInstances   #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+
+module GHCup.Utils.File (
+  mergeFileTree,
+  copyFileE,
+  findFilesDeep,
+  getDirectoryContentsRecursive,
+  getDirectoryContentsRecursiveBFS,
+  getDirectoryContentsRecursiveDFS,
+  getDirectoryContentsRecursiveUnsafe,
+  getDirectoryContentsRecursiveBFSUnsafe,
+  getDirectoryContentsRecursiveDFSUnsafe,
+  recordedInstallationFile,
+  module GHCup.Utils.File.Common,
+
+  executeOut,
+  execLogged,
+  exec,
+  toProcessError,
+  chmod_755,
+  isBrokenSymlink,
+  copyFile,
+  deleteFile,
+  install,
+  removeEmptyDirectory,
+) where
+
+import GHCup.Utils.Dirs
+import GHCup.Utils.File.Common
+#if IS_WINDOWS
+import GHCup.Utils.File.Windows
+#else
+import GHCup.Utils.File.Posix
+#endif
+import           GHCup.Errors
+import           GHCup.Types
+import           GHCup.Types.Optics
+import           GHCup.Utils.Prelude
+
+import           Text.Regex.Posix
+import           Control.Exception.Safe
+import           Haskus.Utils.Variant.Excepts
+import           Control.Monad.Reader
+import           System.FilePath
+import           Text.PrettyPrint.HughesPJClass (prettyShow)
+
+import qualified Data.Text                     as T
+import qualified Streamly.Prelude              as S
+
+
+mergeFileTree :: (MonadMask m, S.MonadAsync m, MonadReader env m, HasDirs env)
+              => GHCupPath                       -- ^ source base directory from which to install findFiles
+              -> InstallDirResolved              -- ^ destination base dir
+              -> Tool
+              -> GHCTargetVersion
+              -> (FilePath -> FilePath -> m ())  -- ^ file copy operation
+              -> m ()
+mergeFileTree sourceBase destBase tool v' copyOp = do
+  -- These checks are not atomic, but we perform them to have
+  -- the opportunity to abort before copying has started.
+  --
+  -- The actual copying might still fail.
+  liftIO $ baseCheck (fromGHCupPath sourceBase)
+  liftIO $ destCheck (fromInstallDir destBase)
+
+  recFile <- recordedInstallationFile tool v'
+  case destBase of
+    IsolateDirResolved _ -> pure ()
+    _ -> do
+      whenM (liftIO $ doesFileExist recFile) $ throwIO $ userError ("mergeFileTree: DB file " <> recFile <> " already exists!")
+      liftIO $ createDirectoryIfMissing True (takeDirectory recFile)
+
+  flip S.mapM_ (getDirectoryContentsRecursive sourceBase) $ \f -> do
+    copy f
+    recordInstalledFile f recFile
+    pure f
+
+ where
+  recordInstalledFile f recFile = do
+    case destBase of
+      IsolateDirResolved _ -> pure ()
+      _ -> liftIO $ appendFile recFile (f <> "\n")
+
+  copy source = do
+    let dest = fromInstallDir destBase </> source
+        src  = fromGHCupPath sourceBase </> source
+
+    when (isAbsolute source)
+      $ throwIO $ userError ("mergeFileTree: source file " <> source <> " is not relative!")
+
+    liftIO . createDirectoryIfMissing True . takeDirectory $ dest
+
+    copyOp src dest
+
+
+  baseCheck src = do
+      when (isRelative src)
+        $ throwIO $ userError ("mergeFileTree: source base directory " <> src <> " is not absolute!")
+      whenM (not <$> doesDirectoryExist src)
+        $ throwIO $ userError ("mergeFileTree: source base directory " <> src <> " does not exist!")
+  destCheck dest = do
+      when (isRelative dest)
+        $ throwIO $ userError ("mergeFileTree: destination base directory " <> dest <> " is not absolute!")
+
+
+
+copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Bool -> Excepts xs m ()
+copyFileE from to = handleIO (throwE . CopyError . show) . liftIO . copyFile from to
+
+
+-- | List all the files in a directory and all subdirectories.
+--
+-- The order places files in sub-directories after all the files in their
+-- parent directories. The list is generated lazily so is not well defined if
+-- the source directory structure changes before the list is used.
+--
+-- depth first
+getDirectoryContentsRecursiveDFS :: (MonadCatch m, S.MonadAsync m, MonadMask m)
+                                 => GHCupPath
+                                 -> S.SerialT m FilePath
+getDirectoryContentsRecursiveDFS (fromGHCupPath -> fp) = getDirectoryContentsRecursiveDFSUnsafe fp
+
+-- breadth first
+getDirectoryContentsRecursiveBFS :: (MonadCatch m, S.MonadAsync m, MonadMask m)
+                                 => GHCupPath
+                                 -> S.SerialT m FilePath
+getDirectoryContentsRecursiveBFS (fromGHCupPath -> fp) = getDirectoryContentsRecursiveBFSUnsafe fp
+
+
+getDirectoryContentsRecursive :: (MonadCatch m, S.MonadAsync m, MonadMask m)
+                              => GHCupPath
+                              -> S.SerialT m FilePath
+getDirectoryContentsRecursive = getDirectoryContentsRecursiveBFS
+
+getDirectoryContentsRecursiveUnsafe :: (MonadCatch m, S.MonadAsync m, MonadMask m)
+                                    => FilePath
+                                    -> S.SerialT m FilePath
+getDirectoryContentsRecursiveUnsafe = getDirectoryContentsRecursiveBFSUnsafe
+
+findFilesDeep :: GHCupPath -> Regex -> IO [FilePath]
+findFilesDeep path regex =
+  S.toList $ S.filter (match regex) $ getDirectoryContentsRecursive path
+
+
+recordedInstallationFile :: ( MonadReader env m
+                            , HasDirs env
+                            )
+                         => Tool
+                         -> GHCTargetVersion
+                         -> m FilePath
+recordedInstallationFile t v' = do
+  Dirs {..}  <- getDirs
+  pure (fromGHCupPath dbDir </> prettyShow t </> T.unpack (tVerToText v'))
+

lib/GHCup/Utils/File/Common.hs

@@ -2,12 +2,13 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
 
-module GHCup.Prelude.File.Search (
-  module GHCup.Prelude.File.Search
+module GHCup.Utils.File.Common (
+  module GHCup.Utils.File.Common
   , ProcessError(..)
   , CapturedProcess(..)
   ) where
 
+import           GHCup.Utils.Prelude
 import           GHCup.Types(ProcessError(..), CapturedProcess(..))
 
 import           Control.Monad.Reader
@@ -26,8 +27,6 @@ import           Text.Regex.Posix
 
 import qualified Data.Text                     as T
 import qualified Text.Megaparsec               as MP
-import Control.Exception.Safe (handleIO)
-import System.Directory.Internal.Prelude (ioeGetErrorType)
 
 
 
@@ -39,7 +38,7 @@ searchPath paths needle = go paths
  where
   go [] = pure Nothing
   go (x : xs) =
-    handleIO (\e -> if ioeGetErrorType e `elem` [InappropriateType, PermissionDenied, NoSuchThing] then go xs else ioError e)
+    hideErrorDefM [InappropriateType, PermissionDenied, NoSuchThing] (go xs)
       $ do
           contents <- listDirectory x
           findM (isMatch x) contents >>= \case
@@ -53,12 +52,6 @@ searchPath paths needle = go paths
   isExecutable :: FilePath -> IO Bool
   isExecutable file = executable <$> getPermissions file
 
-  -- TODO: inlined from GHCup.Prelude
-  findM ~p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
-  ifM ~b ~t ~f = do
-    b' <- b
-    if b' then t else f
-
 
 -- | Check wether a binary is shadowed by another one that comes before
 -- it in PATH. Returns the path to said binary, if any.
@@ -113,3 +106,7 @@ findFiles' path parser = do
   pure $ filter (\fp -> either (const False) (const True) $ MP.parse parser "" (T.pack fp)) contents
 
 
+checkFileAlreadyExists :: (MonadIO m) => FilePath -> m Bool
+checkFileAlreadyExists fp = liftIO $ doesFileExist fp
+
+

lib/GHCup/Utils/File/Common.hs-boot

@@ -0,0 +1,5 @@
+module GHCup.Utils.File.Common where
+
+import           Text.Regex.Posix
+
+findFiles :: FilePath -> Regex -> IO [FilePath]

lib/GHCup/Utils/File/Posix.hs

@@ -2,26 +2,28 @@
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE DataKinds  #-}
 {-# LANGUAGE MultiWayIf  #-}
-{-# LANGUAGE CApiFFI #-}
 
 {-|
 Module      : GHCup.Utils.File.Posix
-Description : Process handling for unix
+Description : File and unix APIs
 Copyright   : (c) Julian Ospald, 2020
 License     : LGPL-3.0
 Maintainer  : hasufell@hasufell.de
 Stability   : experimental
 Portability : POSIX
+
+This module handles file and executable handling.
+Some of these functions use sophisticated logging.
 -}
-module GHCup.Prelude.Process.Posix where
+module GHCup.Utils.File.Posix where
 
 import           GHCup.Utils.Dirs
-import           GHCup.Prelude.File
-import           GHCup.Prelude.File.Posix
-import           GHCup.Prelude
-import           GHCup.Prelude.Logger
+import           GHCup.Utils.File.Common
+import           GHCup.Utils.Prelude
+import           GHCup.Utils.Logger
 import           GHCup.Types
 import           GHCup.Types.Optics
+import           GHCup.Utils.File.Posix.Traversals
 
 import           Control.Concurrent
 import           Control.Concurrent.Async
@@ -36,11 +38,16 @@ import           Data.IORef
 import           Data.Sequence                  ( Seq, (|>) )
 import           Data.List
 import           Data.Word8
+import           Foreign.C.String
+import           Foreign.C.Types
 import           GHC.IO.Exception
-import           System.IO                      ( stderr )
-import           System.IO.Error      hiding    ( catchIOError )
+import           System.IO                      ( stderr, hClose, hSetBinaryMode )
+import           System.IO.Error
 import           System.FilePath
 import           System.Posix.Directory
+import           System.Posix.Error             ( throwErrnoPathIfMinus1Retry )
+import           System.Posix.Internals         ( withFilePath )
+import           System.Posix.Files
 import           System.Posix.IO
 import           System.Posix.Process           ( ProcessStatus(..) )
 import           System.Posix.Types
@@ -50,12 +57,27 @@ import qualified Control.Exception             as EX
 import qualified Data.Sequence                 as Sq
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
+import qualified System.Posix.Directory        as PD
+import qualified System.Posix.Files            as PF
 import qualified System.Posix.Process          as SPP
+import qualified System.Posix.IO               as SPI
 import qualified System.Console.Terminal.Size  as TP
+import qualified System.Posix as Posix
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.Lazy          as BL
 import qualified "unix-bytestring" System.Posix.IO.ByteString
                                                as SPIB
+import qualified Streamly.FileSystem.Handle    as FH
+import qualified Streamly.Internal.FileSystem.Handle
+                                               as IFH
+import qualified Streamly.Prelude              as S
+import qualified GHCup.Utils.File.Posix.Foreign as FD
+import qualified Streamly.Internal.Data.Stream.StreamD.Type
+                                               as D
+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 )
 
 
 
@@ -360,3 +382,240 @@ toProcessError exe args mps = case mps of
 
 
 
+chmod_755 :: (MonadReader env m, HasLog env, MonadIO m) => FilePath -> m ()
+chmod_755 fp = do
+  let exe_mode =
+          nullFileMode
+            `unionFileModes` ownerExecuteMode
+            `unionFileModes` ownerReadMode
+            `unionFileModes` ownerWriteMode
+            `unionFileModes` groupExecuteMode
+            `unionFileModes` groupReadMode
+            `unionFileModes` otherExecuteMode
+            `unionFileModes` otherReadMode
+  logDebug ("chmod 755 " <> T.pack fp)
+  liftIO $ setFileMode fp exe_mode
+
+
+-- |Default permissions for a new file.
+newFilePerms :: FileMode
+newFilePerms =
+  ownerWriteMode
+    `unionFileModes` ownerReadMode
+    `unionFileModes` groupWriteMode
+    `unionFileModes` groupReadMode
+    `unionFileModes` otherWriteMode
+    `unionFileModes` otherReadMode
+
+
+-- | Checks whether the binary is a broken link.
+isBrokenSymlink :: FilePath -> IO Bool
+isBrokenSymlink fp = do
+  try (pathIsSymbolicLink fp) >>= \case
+    Right True -> do
+      let symDir = takeDirectory fp
+      tfp <- getSymbolicLinkTarget fp
+      not <$> doesPathExist
+        -- this drops 'symDir' if 'tfp' is absolute
+        (symDir </> tfp)
+    Right b -> pure b
+    Left e | isDoesNotExistError e -> pure False
+           | otherwise -> throwIO e
+
+copyFile :: FilePath   -- ^ source file
+         -> FilePath   -- ^ destination file
+         -> Bool       -- ^ fail if file exists
+         -> IO ()
+copyFile from to fail' = do
+  bracket
+    (openFdHandle from SPI.ReadOnly [FD.oNofollow] Nothing)
+    (hClose . snd)
+    $ \(fromFd, fH) -> do
+        sourceFileMode <- fileMode <$> getFdStatus fromFd
+        let dflags = [ FD.oNofollow
+                     , if fail' then FD.oExcl else FD.oTrunc
+                     ]
+        bracket
+          (openFdHandle to SPI.WriteOnly dflags $ Just sourceFileMode)
+          (hClose . snd)
+          $ \(_, tH) -> do
+              hSetBinaryMode fH True
+              hSetBinaryMode tH True
+              streamlyCopy (fH, tH)
+ where
+  openFdHandle fp omode flags fM = do
+    fd      <- openFd' fp omode flags fM
+    handle' <- SPI.fdToHandle fd
+    pure (fd, handle')
+  streamlyCopy (fH, tH) =
+    S.fold (FH.writeChunks tH) $ IFH.toChunksWithBufferOf (256 * 1024) fH
+
+foreign import ccall unsafe "open"
+   c_open :: CString -> CInt -> Posix.CMode -> IO CInt
+
+
+open_  :: CString
+       -> Posix.OpenMode
+       -> [FD.Flags]
+       -> Maybe Posix.FileMode
+       -> IO Posix.Fd
+open_ str how optional_flags maybe_mode = do
+    fd <- c_open str all_flags mode_w
+    return (Posix.Fd fd)
+  where
+    all_flags  = FD.unionFlags $ optional_flags ++ [open_mode] ++ creat
+
+
+    (creat, mode_w) = case maybe_mode of
+                        Nothing -> ([],0)
+                        Just x  -> ([FD.oCreat], x)
+
+    open_mode = case how of
+                   Posix.ReadOnly  -> FD.oRdonly
+                   Posix.WriteOnly -> FD.oWronly
+                   Posix.ReadWrite -> FD.oRdwr
+
+
+-- |Open and optionally create this file. See 'System.Posix.Files'
+-- for information on how to use the 'FileMode' type.
+--
+-- Note that passing @Just x@ as the 4th argument triggers the
+-- `oCreat` status flag, which must be set when you pass in `oExcl`
+-- to the status flags. Also see the manpage for @open(2)@.
+openFd' :: FilePath
+        -> Posix.OpenMode
+        -> [FD.Flags]               -- ^ status flags of @open(2)@
+        -> Maybe Posix.FileMode  -- ^ @Just x@ => creates the file with the given modes, Nothing => the file must exist.
+        -> IO Posix.Fd
+openFd' name how optional_flags maybe_mode =
+   withFilePath name $ \str ->
+     throwErrnoPathIfMinus1Retry "openFd" name $
+       open_ str how optional_flags maybe_mode
+
+
+-- |Deletes the given file. Raises `eISDIR`
+-- if run on a directory. Does not follow symbolic links.
+--
+-- Throws:
+--
+--    - `InappropriateType` for wrong file type (directory)
+--    - `NoSuchThing` if the file does not exist
+--    - `PermissionDenied` if the directory cannot be read
+--
+-- Notes: calls `unlink`
+deleteFile :: FilePath -> IO ()
+deleteFile = removeLink
+
+
+-- |Recreate a symlink.
+--
+-- In `Overwrite` copy mode only files and empty directories are deleted.
+--
+-- Safety/reliability concerns:
+--
+--    * `Overwrite` mode is inherently non-atomic
+--
+-- Throws:
+--
+--    - `InvalidArgument` if source file is wrong type (not a symlink)
+--    - `PermissionDenied` if output directory cannot be written to
+--    - `PermissionDenied` if source directory cannot be opened
+--    - `SameFile` if source and destination are the same file
+--      (`HPathIOException`)
+--
+--
+-- Throws in `Strict` mode only:
+--
+--    - `AlreadyExists` if destination already exists
+--
+-- Throws in `Overwrite` mode only:
+--
+--    - `UnsatisfiedConstraints` if destination file is non-empty directory
+--
+-- Notes:
+--
+--    - calls `symlink`
+recreateSymlink :: FilePath   -- ^ the old symlink file
+                -> FilePath   -- ^ destination file
+                -> Bool       -- ^ fail if destination file exists
+                -> IO ()
+recreateSymlink symsource newsym fail' = do
+  sympoint <- readSymbolicLink symsource
+  case fail' of
+    True  -> pure ()
+    False ->
+      hideError doesNotExistErrorType $ deleteFile newsym
+  createSymbolicLink sympoint newsym
+
+
+-- copys files, recreates symlinks, fails on all other types
+install :: FilePath -> FilePath -> Bool -> IO ()
+install from to fail' = do
+  fs <- PF.getSymbolicLinkStatus from
+  decide fs
+ where
+  decide fs | PF.isRegularFile fs     = copyFile from to fail'
+            | PF.isSymbolicLink fs    = recreateSymlink from to fail'
+            | otherwise               = ioError $ mkIOError illegalOperationErrorType "install: not a regular file or symlink" Nothing (Just from)
+
+
+removeEmptyDirectory :: FilePath -> IO ()
+removeEmptyDirectory = PD.removeDirectory
+
+
+-- | Create an 'Unfold' of directory contents.
+unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
+unfoldDirContents = U.bracket (liftIO . openDirStream) (liftIO . closeDirStream) (Unfold step return)
+ where
+  {-# INLINE [0] step #-}
+  step dirstream = do
+    (typ, e) <- liftIO $ readDirEnt dirstream
+    return $ if
+      | null e    -> D.Stop
+      | "." == e  -> D.Skip dirstream
+      | ".." == e -> D.Skip dirstream
+      | otherwise -> D.Yield (typ, e) dirstream
+
+
+getDirectoryContentsRecursiveDFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
+                                       => FilePath
+                                       -> S.SerialT m FilePath
+getDirectoryContentsRecursiveDFSUnsafe fp = go ""
+ where
+  go cd = flip S.concatMap (S.unfold unfoldDirContents (fp </> cd)) $ \(t, f) ->
+    if | t == FD.dtDir -> go (cd </> f)
+       | otherwise     -> pure (cd </> f)
+
+
+getDirectoryContentsRecursiveUnfold :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath FilePath
+getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""]))
+ where
+  {-# INLINE [0] step #-}
+  step (_, Nothing, []) = return D.Stop
+
+  step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
+    (dt, f) <- liftIO $ readDirEnt dirstream
+    if | FD.dtUnknown == dt -> do
+           runIOFinalizer finalizer
+           return $ D.Skip (topdir, Nothing, dirs)
+       | f == "." || f == ".."
+                        -> return $ D.Skip               (topdir, Just (cdir, dirstream, finalizer), dirs)
+       | FD.dtDir == dt -> return $ D.Skip               (topdir, Just (cdir, dirstream, finalizer), (cdir </> f):dirs)
+       | otherwise      -> return $ D.Yield (cdir </> f) (topdir, Just (cdir, dirstream, finalizer), dirs)
+
+  step (topdir, Nothing, dir:dirs) = do
+    (s, f) <- acquire (topdir </> dir)
+    return $ D.Skip (topdir, Just (dir, s, f), dirs)
+
+  acquire dir =
+    withRunInIO $ \run -> mask_ $ run $ do
+        dirstream <- liftIO $ openDirStream dir
+        ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
+        return (dirstream, ref)
+
+getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)
+                                       => FilePath
+                                       -> S.SerialT m FilePath
+getDirectoryContentsRecursiveBFSUnsafe = S.unfold getDirectoryContentsRecursiveUnfold
+
+

lib/GHCup/Utils/File/Posix/Foreign.hsc

@@ -1,6 +1,6 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-module GHCup.Prelude.File.Posix.Foreign where
+module GHCup.Utils.File.Posix.Foreign where
 
 import Data.Bits
 import Data.List (foldl')

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

@@ -7,7 +7,7 @@
 {-# OPTIONS_GHC -Wall #-}
 
 
-module GHCup.Prelude.File.Posix.Traversals (
+module GHCup.Utils.File.Posix.Traversals (
 -- lower-level stuff
   readDirEnt
 , unpackDirStream
@@ -17,7 +17,7 @@ module GHCup.Prelude.File.Posix.Traversals (
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
 #endif
-import GHCup.Prelude.File.Posix.Foreign
+import GHCup.Utils.File.Posix.Foreign
 
 import Unsafe.Coerce (unsafeCoerce)
 import Foreign.C.Error
@@ -36,8 +36,8 @@ import System.Posix.Internals (peekFilePath)
 ----------------------------------------------------------
 -- dodgy stuff
 
-data {-# CTYPE "DIR" #-} CDir
-data {-# CTYPE "struct dirent" #-} CDirent
+type CDir = ()
+type 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 capi unsafe "dirutils.h __posixdir_d_type"
+foreign import ccall unsafe "__posixdir_d_type"
   c_type :: Ptr CDirent -> IO DirType
 
 ----------------------------------------------------------