Bump stack resolver

Fixes #209

.gitlab-ci.yml

@@ -99,11 +99,12 @@ variables:
   script:
     - bash ./.gitlab/script/ghcup_version.sh
   variables:
-    JSON_VERSION: "0.0.5"
+    JSON_VERSION: "0.0.7"
   artifacts:
     expire_in: 2 week
     paths:
       - golden
+      - dist-newstyle/cache/
     when: on_failure
 
 # .test_ghcup_scoop:
@@ -202,10 +203,11 @@ variables:
     expire_in: 2 week
     paths:
       - out
+      - dist-newstyle/cache/
   only:
     - tags
   variables:
-    JSON_VERSION: "0.0.5"
+    JSON_VERSION: "0.0.7"
 
 ######## stack test ########
 
@@ -228,7 +230,7 @@ test:linux:bootstrap_script:
   script:
     - ./.gitlab/script/ghcup_bootstrap.sh
   variables:
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
   extends:
     - .debian
@@ -245,7 +247,7 @@ test:windows:bootstrap_powershell_script:
     - "[Environment]::SetEnvironmentVariable('CABAL_DIR', $null, [System.EnvironmentVariableTarget]::User)"
     - bash ./.gitlab/after_script.sh
   variables:
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
   extends:
     - .windows
@@ -253,19 +255,11 @@ test:windows:bootstrap_powershell_script:
 
 ######## linux test ########
 
-test:linux:recommended:
+test:linux:
   stage: test
   extends: .test_ghcup_version:linux
   variables:
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
-    CABAL_VERSION: "3.4.0.0"
-  needs: []
-
-test:linux:latest:
-  stage: test
-  extends: .test_ghcup_version:linux
-  variables:
-    GHC_VERSION: "9.0.1"
     CABAL_VERSION: "3.4.0.0"
   needs: []
 
@@ -275,8 +269,8 @@ test:linux:cross-armv7:
     - .test_ghcup_version
     - .debian
   variables:
-    GHC_VERSION: "8.10.4"
+    GHC_VERSION: "8.10.5"
-    GHC_TARGET_VERSION: "8.10.5"
+    GHC_TARGET_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
     CROSS: "arm-linux-gnueabihf"
   needs: []
@@ -293,7 +287,7 @@ test:linux:git:hadrian:
     - .test_ghcup_version
     - .debian
   variables:
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     GHC_GIT_TAG: "ghc-9.0.1-release"
     GHC_GIT_VERSION: "9.0.1"
     CABAL_VERSION: "3.4.0.0"
@@ -309,17 +303,17 @@ test:linux:git:hadrian:
 
 ######## linux 32bit test ########
 
-test:linux:recommended:32bit:
+test:linux:32bit:
   stage: test
   extends: .test_ghcup_version:linux32
   variables:
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.2.0.0"
   needs: []
 
 ######## arm tests ########
 
-test:linux:recommended:armv7:
+test:linux:armv7:
   stage: test
   extends: .test_ghcup_version:armv7
   variables:
@@ -329,7 +323,7 @@ test:linux:recommended:armv7:
   when: manual
   needs: []
 
-test:linux:recommended:aarch64:
+test:linux:aarch64:
   stage: test
   extends: .test_ghcup_version:aarch64
   variables:
@@ -341,7 +335,7 @@ test:linux:recommended:aarch64:
 
 ######## darwin test ########
 
-test:mac:recommended:
+test:mac:
   stage: test
   extends: .test_ghcup_version:darwin
   variables:
@@ -349,19 +343,11 @@ test:mac:recommended:
     CABAL_VERSION: "3.4.0.0"
   needs: []
 
-test:mac:latest:
+test:mac:aarch64:
-  stage: test
-  extends: .test_ghcup_version:darwin
-  variables:
-    GHC_VERSION: "9.0.1"
-    CABAL_VERSION: "3.4.0.0"
-  needs: []
-
-test:mac:recommended:aarch64:
   stage: test
   extends: .test_ghcup_version:darwin:aarch64
   variables:
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
   needs: []
   allow_failure: true
@@ -369,7 +355,7 @@ test:mac:recommended:aarch64:
 
 ######## freebsd test ########
 
-test:freebsd:recommended:
+test:freebsd:
   stage: test
   extends: .test_ghcup_version:freebsd
   variables:
@@ -381,11 +367,11 @@ test:freebsd:recommended:
 
 ######## windows test ########
 
-test:windows:recommended:
+test:windows:
   stage: test
   extends: .test_ghcup_version:windows
   variables:
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
   needs: []
 
@@ -398,7 +384,7 @@ test:windows:recommended:
 
 release:linux:64bit:
   stage: release
-  needs: ["test:linux:recommended", "test:linux:latest"]
+  needs: ["test:linux"]
   extends:
     - .alpine:64bit
     - .release_ghcup
@@ -406,13 +392,13 @@ release:linux:64bit:
     - ./.gitlab/before_script/linux/alpine/install_deps.sh
   variables:
     ARTIFACT: "x86_64-linux-ghcup"
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
 
 
 release:linux:32bit:
   stage: release
-  needs: ["test:linux:recommended:32bit"]
+  needs: ["test:linux:32bit"]
   extends:
     - .alpine:32bit
     - .release_ghcup
@@ -420,12 +406,12 @@ release:linux:32bit:
     - ./.gitlab/before_script/linux/alpine/install_deps.sh
   variables:
     ARTIFACT: "i386-linux-ghcup"
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.2.0.0"
 
 release:linux:armv7:
   stage: release
-  needs: ["test:linux:recommended:armv7"]
+  needs: ["test:linux:armv7"]
   extends:
     - .linux:armv7
     - .release_ghcup
@@ -439,7 +425,7 @@ release:linux:armv7:
 
 release:linux:aarch64:
   stage: release
-  needs: ["test:linux:recommended:aarch64"]
+  needs: ["test:linux:aarch64"]
   extends:
     - .linux:aarch64
     - .release_ghcup
@@ -455,7 +441,7 @@ release:linux:aarch64:
 
 release:darwin:
   stage: release
-  needs: ["test:mac:recommended", "test:mac:latest"]
+  needs: ["test:mac"]
   extends:
     - .darwin
     - .release_ghcup
@@ -464,13 +450,13 @@ release:darwin:
     - ./.gitlab/before_script/darwin/install_deps.sh
   variables:
     ARTIFACT: "x86_64-apple-darwin-ghcup"
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
     MACOSX_DEPLOYMENT_TARGET: "10.7"
 
 release:darwin:aarch64:
   stage: release
-  needs: ["test:mac:recommended:aarch64"]
+  needs: ["test:mac:aarch64"]
   extends:
     - .darwin:aarch64
     - .release_ghcup
@@ -497,7 +483,7 @@ release:darwin:aarch64:
     runInNixShell ./.gitlab/script/ghcup_release.sh 2>&1
   variables:
     ARTIFACT: "aarch64-apple-darwin-ghcup"
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
     MACOSX_DEPLOYMENT_TARGET: "10.7"
   allow_failure: true
@@ -507,7 +493,7 @@ release:darwin:aarch64:
 
 release:freebsd:
   stage: release
-  needs: ["test:freebsd:recommended"]
+  needs: ["test:freebsd"]
   extends:
     - .freebsd
     - .release_ghcup
@@ -516,7 +502,7 @@ release:freebsd:
     - ./.gitlab/before_script/freebsd/install_deps.sh
   variables:
     ARTIFACT: "x86_64-portbld-freebsd-ghcup"
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
   allow_failure: true
 
@@ -524,7 +510,7 @@ release:freebsd:
 
 release:windows:
   stage: release
-  needs: ["test:windows:recommended"]
+  needs: ["test:windows"]
   extends:
     - .windows
     - .release_ghcup
@@ -533,7 +519,7 @@ release:windows:
     - bash ./.gitlab/before_script/windows/install_deps.sh
   variables:
     ARTIFACT: "x86_64-mingw64-ghcup"
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
 
 ######## hlint ########
@@ -547,7 +533,7 @@ hlint:
   script:
     - ./.gitlab/script/hlint.sh
   variables:
-    GHC_VERSION: "8.10.5"
+    GHC_VERSION: "8.10.6"
     CABAL_VERSION: "3.4.0.0"
     JSON_VERSION: "0.0.4"
   allow_failure: true

.gitlab/before_script/darwin/install_deps.sh

@@ -7,7 +7,7 @@ set -eux
 mkdir -p "${TMPDIR}"
 
 if [ $ARCH = 'ARM64' ] ; then
-	curl -sSfL https://downloads.haskell.org/~ghcup/0.1.15.1/aarch64-apple-darwin-ghcup-0.1.15.1 > ./ghcup-bin
+	curl -sSfL https://downloads.haskell.org/~ghcup/aarch64-apple-darwin-ghcup > ./ghcup-bin
 	chmod +x ghcup-bin
 else
 	curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ./ghcup-bin

.gitlab/before_script/linux/alpine/install_deps.sh

@@ -52,3 +52,7 @@ apk add --no-cache \
 	xz-dev \
 	ncurses-static
 
+if [ "${ARCH}" = "32" ] ; then
+	apk add --no-cache \
+		bsd-compat-headers
+fi

.gitlab/before_script/windows/install_deps.sh

@@ -9,7 +9,7 @@ mkdir -p "${TMPDIR}" "${CABAL_DIR}"
 mkdir -p "$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
 
 CI_PROJECT_DIR=$(pwd)
-curl -o ghcup.exe https://downloads.haskell.org/~ghcup/0.1.15.1/x86_64-mingw64-ghcup-0.1.15.1.exe
+curl -o ghcup.exe https://downloads.haskell.org/~ghcup/x86_64-mingw64-ghcup.exe
 chmod +x ghcup.exe
 
 ./ghcup.exe install ${GHC_VERSION}

.gitlab/script/ghcup_release.sh

@@ -18,7 +18,7 @@ ecabal update
 
 if [ "${OS}" = "LINUX" ] ; then
 	if [ "${ARCH}" = "32" ] ; then
-		ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui -ftar
+		ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
 	elif [ "${ARCH}" = "64" ] ; then
 		ecabal build -w ghc-${GHC_VERSION} --ghc-options='-split-sections -optl-static' -ftui
 	else

.gitlab/script/ghcup_version.sh

@@ -12,6 +12,10 @@ ecabal() {
 	cabal "$@"
 }
 
+raw_eghcup() {
+	ghcup -v -c "$@"
+}
+
 eghcup() {
 	if [ "${OS}" = "WINDOWS" ] ; then
 		ghcup -v -c -s file:/$CI_PROJECT_DIR/ghcup-${JSON_VERSION}.yaml "$@"
@@ -20,6 +24,12 @@ eghcup() {
 	fi
 }
 
+if [ "${OS}" = "WINDOWS" ] ; then
+	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
+else
+	GHCUP_DIR="${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
+fi
+
 git describe --always
 
 ### build
@@ -32,13 +42,25 @@ if [ "${OS}" = "DARWIN" ] ; then
 	ecabal haddock -w ghc-${GHC_VERSION} -ftui
 elif [ "${OS}" = "LINUX" ] ; then
 	if [ "${ARCH}" = "32" ] ; then
-		ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar
+		ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
-		ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar ghcup-test
+		ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
-		ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui -ftar
+		ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
 	else
 		ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui
 		ecabal test -w ghc-${GHC_VERSION} -finternal-downloader -ftui ghcup-test
 		ecabal haddock -w ghc-${GHC_VERSION} -finternal-downloader -ftui
+
+		if [ "${ARCH}" = "64" ] ; then
+			# doctest
+			curl -sL https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal-docspec/cabal-docspec-0.0.0.20210228_p1.tar.bz2 > cabal-docspec.tar.bz2
+			echo '3a10f6fec16dbd18efdd331b1cef5d2d342082da42f5b520726d1fa6a3990d12  cabal-docspec.tar.bz2' | sha256sum -c -
+			tar -xjf cabal-docspec.tar.bz2 cabal-docspec
+			mv cabal-docspec "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
+			rm -f cabal-docspec.tar.bz2
+			chmod a+x "$CI_PROJECT_DIR"/.local/bin/cabal-docspec
+
+			cabal-docspec -XCPP -XTypeSynonymInstances -XOverloadedStrings -XPackageImports --check-properties
+		fi
 	fi
 elif [ "${OS}" = "FREEBSD" ] ; then
 	ecabal build -w ghc-${GHC_VERSION} -finternal-downloader -ftui --constraint="zip +disable-zstd"
@@ -65,11 +87,7 @@ fi
 
 ### cleanup
 
-if [ "${OS}" = "WINDOWS" ] ; then
+rm -rf "${GHCUP_DIR}"
-	rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/ghcup
-else
-	rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
-fi
 
 ### manual cli based testing
 
@@ -88,6 +106,7 @@ cabal --version
 
 eghcup debug-info
 
+# also test etags
 eghcup list
 eghcup list -t ghc
 eghcup list -t cabal
@@ -109,7 +128,20 @@ else
 	if [ "${OS}" = "LINUX" ] ; then
 		eghcup --downloader=wget prefetch ghc 8.10.3
 		eghcup --offline install ghc 8.10.3
-	else # test wget a bit
+		if [ "${ARCH}" = "64" ] ; then
+			expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-linux.files" | sort)
+			actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
+			[ "${actual}" = "${expected}" ]
+			unset actual expected
+		fi
+	elif [ "${OS}" = "WINDOWS" ] ; then
+		eghcup prefetch ghc 8.10.3
+		eghcup --offline install ghc 8.10.3
+		expected=$(cat "$( cd "$(dirname "$0")" ; pwd -P )/../ghc-8.10.3-windows.files" | sort)
+		actual=$(cd "${GHCUP_DIR}/ghc/8.10.3/" && find | sort)
+		[ "${actual}" = "${expected}" ]
+		unset actual expected
+	else
 		eghcup prefetch ghc 8.10.3
 		eghcup --offline install ghc 8.10.3
 	fi
@@ -155,6 +187,55 @@ if [ "${OS}" = "LINUX" ] ; then
 	fi
 fi
 
+sha_sum() {
+	if [ "${OS}" = "FREEBSD" ] ; then
+		sha256 "$@"
+	else
+		sha256sum "$@"
+	fi
+
+}
+
+# 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
+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" ]
+	fi
+fi
 
 eghcup upgrade
 eghcup upgrade -f
@@ -162,8 +243,4 @@ eghcup upgrade -f
 
 # nuke
 eghcup nuke
-if [ "${OS}" = "WINDOWS" ] ; then
+[ ! -e "${GHCUP_DIR}" ]
-	[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/ghcup" ]
-else
-	[ ! -e "${GHCUP_INSTALL_BASE_PREFIX}/.ghcup" ]
-fi

.gitlab/shell.nix

@@ -43,6 +43,7 @@
 
   # unconditionally add the MacOSX.sdk and TargetConditional.h
   export NIX_CFLAGS_COMPILE+=" -isystem /Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/include"
+  export NIX_LDFLAGS="-L/Library/Developer/CommandLineTools/SDKs/MacOSX.sdk/usr/lib $NIX_LDFLAGS"
 
   '';
 

.travis.yml

@@ -0,0 +1,25 @@
+jobs:
+  include:
+    - os: osx
+      osx_image: xcode10.1
+      language: generic
+      env: ARTIFACT=x86_64-apple-darwin-10.13-ghcup
+
+    - os: osx
+      osx_image: xcode11.3
+      language: generic
+      env: ARTIFACT=x86_64-apple-darwin-10.14-ghcup
+
+
+script: ".travis/build.sh"
+
+deploy:
+  provider: releases
+  api_key:
+    secure: "hT2od8Iy04tdFVuonPSWv0NX5hZDmv4al8Q0GbIWmviUetROuM7c6/MCHUcgyiw6H2L3pmH4F24GBYWpKBT3ZMbxrKXhZOZ3KPLXzlnuRlm1qymKqqwsJs3466bMftaiBr16rx1VpAuditN4A32oSmTFcQAJc84Bxn2WZ4t8hk9muS8YPyLhqg3/NxT6ob8dzNp9eS2cA0WODMb/fMzaMruRtepSK8JvuXb/SnTvaDcl9plmPzEa+eW54jwVsDps8ZpQMQlTtGIjYHIwTQ36/iLH4LoAvD7OEnB7qf753LOzmI/bvlB75xYGsLxe1qgpzPMjuG3AK0jb2KGSZCzyAyrbBFSQMIyC1gNKMtab3CohnA9WdQqAT1xrzPzA9zNw516G5Fn/z+t9Ek1f6L2OYO2hJfweNhWh+ChAIsOags2QBpqc0qjkwUS4wqxCWBdyVfgPTUoGelvjCfjQgypgIyLEHFvXt9rlj+kd97FY7nG3vxZrsvWTKKKT551OqUYX5zWTyvGR71jKyNst/p93Pg3DkRy31gHrGnG9zfNgN5tWxJqDd/suR/BAFTp0VtkFb8fR3ct7WMVeJXtE2+bKqxO5Fnocs1VjEm8pKPk7glnp0muu08kaO0h54wiSOCbk1RvO1KZtHue4wKWrHcI18dwW2WtzoBQ4P1lOSkS81UY="
+  file: $ARTIFACT
+  on:
+    repo: hasufell/ghcup-hs
+    tags: true
+  skip_cleanup: true
+  draft: true

.travis/build.sh

@@ -0,0 +1,28 @@
+#!/bin/sh
+
+set -ex
+
+mkdir -p ~/.ghcup/bin
+curl -sSfL https://downloads.haskell.org/~ghcup/x86_64-apple-darwin-ghcup > ~/.ghcup/bin/ghcup
+chmod +x ~/.ghcup/bin/ghcup
+
+export PATH="$HOME/.ghcup/bin:$PATH"
+
+ghcup install 8.10.4
+ghcup install-cabal 3.4.0.0
+ghcup set 8.10.4
+
+
+## install ghcup
+
+cabal update
+
+(
+       cd /tmp
+       cabal install --installdir="$HOME"/.ghcup/bin hspec-discover
+)
+
+cabal build --constraint="zlib +static" --constraint="lzma +static" -ftui
+cp "$(cabal new-exec --verbose=0 --offline sh -- -c 'command -v ghcup')" .
+strip ./ghcup
+cp ghcup "./${ARTIFACT}"

CHANGELOG.md

@@ -1,8 +1,32 @@
 # Revision history for ghcup
 
-## 0.1.16 -- ????-??-??
+## 0.1.16.2 -- 2021-08-12
+
+* Add isolated installations wrt [#141](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/141) by Arjun Kathuria
+* Implement config cli MVP wrt [#134](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/134) by Oleksii Dorozhkin
+* Fix `ghcup compile ghc --flavor`
+* Fix minor installation bug causing increased disk space wrt [#139](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/139)
+* Improved error handling wrt [#136](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/136)
+* Various improvements to metadata download when using `file://` and `--offline` wrt [#137](https://gitlab.haskell.org/haskell/ghcup-hs/-/merge_requests/137)
+
+## 0.1.16.1 -- 2021-07-29
 
 * Add 'nuke' subcommand wrt [#135](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/135), implemented by Arjun Kathuria
+* Add uninstallation powershell script on windows wrt [#150](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/150)
+* Improve logging
+* Fix building GHC cross compiler wrt [#180](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/180)
+* Allow to use hadrian as build system (for git based versions only) wrt [#35](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/35)
+* Allow passing `--flavor` to `ghcup compile ghc`
+* Support new GHC `bin/` directory format wrt [ghc/ghc#20074](https://gitlab.haskell.org/ghc/ghc/-/issues/20074#note_363720)
+* Implement `whereis` subcommand wrt [#173](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/173)
+* Add `--offline` switch and `prefetch` subcommand wrt [#186](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/186)
+* Implement ETAGs hashing for metadata downloads to speed up `ghcup list` wrt [#193](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/193)
+* Avoid unnecessary fetching of ghcup metadata in some commands
+* Avoid unnecessary update checks for some commands
+* Preserve mtimes on unpacked GHC tarballs on windows wrt [#187](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/187), fixing issues with `ghc-pkg`
+* Fix lesser bug in `ghcup list` for stray stack versions wrt [#183](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/183)
+* Major redo on how file removal on windows works, avoiding partial removals etc, wrt [#165](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/165)
+* Improve ghcup tui for screen readers wrt [github/#4](https://github.com/haskell/ghcup-hs/pull/4), thanks to Mario Lang
 
 ## 0.1.15.2 -- 2021-06-13
 

README.md

@@ -6,6 +6,11 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
 
 ## Table of Contents
 
+[![Join the chat at Libera.chat](https://img.shields.io/badge/chat-on%20libera%20IRC-brightgreen.svg)](https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup)
+[![Join the chat at Matrix.org](https://img.shields.io/matrix/haskell-tooling:matrix.org?label=chat%20on%20matrix.org)](https://app.element.io/#/room/#haskell-tooling:matrix.org)
+[![Join the chat at Discord](https://img.shields.io/discord/280033776820813825?label=chat%20on%20discord)](https://discord.gg/pKYf3zDQU7)
+[![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)
+
    * [Installation](#installation)
      * [Simple bootstrap](#simple-bootstrap)
      * [Manual install](#manual-install)
@@ -18,6 +23,8 @@ Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [p
      * [XDG support](#xdg-support)
      * [Env variables](#env-variables)
      * [Installing custom bindists](#installing-custom-bindists)
+     * [Isolated Installs](#isolated-installs)
+     * [Tips and tricks](#tips-and-tricks)
    * [Design goals](#design-goals)
    * [How](#how)
    * [Known users](#known-users)
@@ -154,6 +161,83 @@ 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).
 
+### Isolated installs
+
+Ghcup also enables you to install a tool (GHC, Cabal, HLS, Stack) at an isolated location of your choosing.
+These installs, as the name suggests, are separate from your main installs and DO NOT conflict with them.
+
+
+- No symlinks are made to these isolated installed tools, you'd have to manually point to them wherever you intend to use them.
+
+- These installs, can also NOT be deleted from ghcup, you'd have to go and manually delete these.
+
+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/  
+   - `ghcup install ghc 8.10.5 --isolate /home/user/isolated_dir/ghc`
+
+2. isolated install Cabal at a location you desire  
+   - `ghcup install cabal --isolate /home/username/my_isolated_dir/`
+
+3. do an isolated install with a custom bindist  
+   - `ghcup install ghc --isolate /home/username/my_isolated_dir/ -u 'https://gitlab.haskell.org/api/v4/projects/1/jobs/artifacts/master/raw/ghc-x86_64-fedora27-linux.tar.xz?job=validate-x86_64-linux-fedora27' head`
+
+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` 
+   ---  
+   
+### Tips and tricks
+
+#### with_ghc wrapper (e.g. for HLS)
+
+Due to some HLS [bugs](https://github.com/mpickering/hie-bios/issues/194) it's necessary that the `ghc` in PATH
+is the one defined in `cabal.project`. With some simple shell functions, we can start our editor with the appropriate
+path prepended.
+
+For bash, in e.g. `~/.bashrc` define:
+
+```sh
+with_ghc() {
+  local np=$(ghcup --offline whereis -d ghc $1 || { ghcup --cache install ghc $1 && ghcup whereis -d ghc $1 ;})
+  if [ -e "${np}" ] ; then
+    shift
+    PATH="$np:$PATH" "$@"
+  else
+    >&2 echo "Cannot find or install GHC version $1"
+    return 1
+  fi
+}
+```
+
+For fish shell, in e.g. `~/.config/fish/config.fish` define:
+
+```fish
+function with_ghc
+  set --local np (ghcup --offline whereis -d ghc $argv[1] ; or begin ghcup --cache install ghc $argv[1] ; and ghcup whereis -d ghc $argv[1] ; end)
+  if test -e "$np"
+    PATH="$np:$PATH" $argv[2..-1]
+  else
+    echo "Cannot find or install GHC version $argv[1]" 1>&2
+    return 1
+  end
+end
+```
+
+Then start a new shell and issue:
+
+```sh
+# replace 'code' with your editor
+with_ghc 8.10.5 code path/to/haskell/source
+```
+
+Cabal and HLS will now see `8.10.5` as the primary GHC, without the need to
+run `ghcup set` all the time when switching between projects.
+
 ## Design goals
 
 1. simplicity
@@ -230,16 +314,110 @@ to figure out whether you have the correct toolchain and
 the correct dependencies. Refer to [the official docs](https://ghc.haskell.org/trac/ghc/wiki/Building/Preparation/Linux)
 on how to prepare your environment for building GHC.
 
+### Stack support
+
+There may be a number of bugs when trying to make ghcup installed GHC versions work with stack,
+such as:
+
+- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/188
+
+Further, stack's upgrade procedure may break/confuse ghcup. There are a number of integration
+issues discussed here:
+
+- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/153
+
+### Windows support
+
+Windows support is in early stages. Since windows doesn't support symbolic links properly,
+ghcup uses a [shimgen wrapper](https://github.com/71/scoop-better-shimexe). It seems to work
+well, but there may be unknown issues with that approach.
+
+Windows 7 and Powershell 2.0 aren't well supported at the moment, also see:
+
+- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/140
+- https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/197
+
 ## FAQ
 
-1. Why reimplement stack?
+### Why reimplement stack?
 
-ghcup is not a reimplementation of stack. The only common part is automatic installation of GHC, but even that differs in scope and design.
+GHCup is not a reimplementation of stack. The only common part is automatic installation of GHC,
+but even that differs in scope and design.
 
-2. Why not support windows?
+### Why should I use ghcup over stack?
 
-We do.
+GHCup is not a replacement for stack. Instead, it supports installing and managing stack versions.
+It does the same for cabal, GHC and HLS. As such, It doesn't make a workflow choice for you.
 
-3. Why the haskell reimplementation?
+### Why should I let ghcup manage stack?
 
-:-)
+You don't need to. However, some users seem to prefer to have a central tool that manages cabal and stack
+at the same time. Additionally, it can allow better sharing of GHC installation across these tools.
+Also see:
+
+* https://docs.haskellstack.org/en/stable/yaml_configuration/#system-ghc
+* https://github.com/commercialhaskell/stack/pull/5585
+
+### Why does ghcup not use stack code?
+
+Oddly, this question has been asked a couple of times. For the curious, here are a few reasons:
+
+1. GHCup started as a shell script. At the time of rewriting it in Haskell, the authors didn't even know that stack exposes *some* of its [installation API](https://hackage.haskell.org/package/stack-2.5.1.1/docs/Stack-Setup.html)
+2. Even if they did, it doesn't seem it would have satisfied their needs
+	  - it didn't support cabal installation, which was the main motivation behind GHCup back then
+	  - depending on a codebase as big as stack for a central part of one's application without having a short contribution pipeline would likely have caused stagnation or resulted in simply copy-pasting the relevant code in order to adjust it
+	  - it's not clear how GHCup would have been implemented with the provided API. It seems the codebases are fairly different. GHCup does a lot of symlink handling to expose a central `bin/` directory that users can easily put in PATH, without having to worry about anything more. It also provides explicit removal functionality, GHC cross-compilation, a TUI, etc etc.
+3. GHCup is built around unix principles and supposed to be simple.
+
+### Why not unify...
+
+#### ...stack and Cabal and do away with standalone installers
+
+GHCup is not involved in such decisions. cabal-install and stack might have a
+sufficiently different user experience to warrant having a choice.
+
+#### ...installer implementations and have a common library
+
+This sounds like an interesting goal. However, GHC installation isn't a hard engineering problem
+and the shared code wouldn't be too exciting. For such an effort to make sense, all involved
+parties would need to collaborate and have a short pipeline to get patches in.
+
+It's true this would solve the integration problem, but following unix principles, we can
+do similar via **hooks**. Both cabal and stack can support installation hooks. These hooks
+can then call into ghcup or anything else, also see:
+
+* https://github.com/haskell/cabal/issues/7394
+* https://github.com/commercialhaskell/stack/pull/5585
+
+#### ...installers (like, all of it)
+
+So far, there hasn't been an **open** discussion about this. Is this even a good idea?
+Sometimes projects converge eventually if their overlap is big enough, sometimes they don't.
+
+While unification sounds like a simplification of the ecosystem, it also takes away choice.
+Take `curl` and `wget` as an example.
+
+How bad do we need this?
+
+### Why not support windows?
+
+Windows is supported since GHCup version 0.1.15.1.
+
+### Why the haskell reimplementation?
+
+GHCup started as a portable posix shell script of maybe 50 LOC. GHC installation itself can be carried out in
+about ~3 lines of shell code (download, unpack , configure+make install). However, much convenient functionality
+has been added since, as well as ensuring that all operations are safe and correct. The shell script ended up with
+over 2k LOC, which was very hard to maintain.
+
+The main concern when switching from a portable shell script to haskell was platform/architecture support.
+However, ghcup now re-uses GHCs CI infrastructure and as such is perfectly in sync with all platforms that
+GHC supports.
+
+### Is GHCup affiliated with the Haskell Foundation?
+
+There has been some collaboration: Windows and Stack support were mainly requested by the Haskell Foundation
+and those seemed interesting features to add.
+
+Other than that, GHCup is dedicated only to its users and is supported by haskell.org through hosting and CI
+infrastructure.

app/ghcup-gen/Validate.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE TemplateHaskell  #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE ViewPatterns     #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Validate where
 
@@ -18,11 +19,7 @@ import           GHCup.Utils
 import           GHCup.Utils.Logger
 import           GHCup.Utils.Version.QQ
 
-#if defined(TAR)
-import qualified Codec.Archive.Tar             as Tar
-#else
 import           Codec.Archive
-#endif
 import           Control.Applicative
 import           Control.Exception.Safe
 import           Control.Monad
@@ -37,7 +34,6 @@ import           Control.Monad.Trans.Resource   ( runResourceT
 import           Data.Containers.ListUtils      ( nubOrd )
 import           Data.IORef
 import           Data.List
-import           Data.String.Interpolate
 import           Data.Versions
 import           Haskus.Utils.Variant.Excepts
 import           Optics
@@ -93,24 +89,23 @@ validate dls _ = do
     if e > 0
       then pure $ ExitFailure e
       else do
-        lift $ $(logInfo) [i|All good|]
+        lift $ $(logInfo) "All good"
         pure ExitSuccess
  where
   checkHasRequiredPlatforms t v tags arch pspecs = do
     let v' = prettyVer v
         arch' = prettyShow arch
     when (notElem (Linux UnknownLinux) pspecs) $ do
-      lift $ $(logError)
+      lift $ $(logError) $
-        [i|Linux UnknownLinux missing for for #{t} #{v'} #{arch'}|]
+        "Linux UnknownLinux missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
       addError
     when ((notElem Darwin pspecs) && arch == A_64) $ do
-      lift $ $(logError) [i|Darwin missing for #{t} #{v'} #{arch'}|]
+      lift $ $(logError) $ "Darwin missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
       addError
-    when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn)
+    when ((notElem FreeBSD pspecs) && arch == A_64) $ lift $ $(logWarn) $
-      [i|FreeBSD missing for #{t} #{v'} #{arch'}|]
+      "FreeBSD missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
     when (notElem Windows pspecs && arch == A_64) $ do
-      lift $ $(logError)
+      lift $ $(logError) $ "Windows missing for for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack arch'
-        [i|Windows missing for for #{t} #{v'} #{arch'}|]
       addError
 
     -- alpine needs to be set explicitly, because
@@ -118,15 +113,15 @@ validate dls _ = do
     -- (although it could be static)
     when (notElem (Linux Alpine) pspecs) $
       case t of
-        GHCup | arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch}|]) >> addError
+        GHCup | arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
         Cabal | v > [vver|2.4.1.0|]
-              , arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]) >> addError
+              , arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)) >> addError
         GHC | Latest `elem` tags || Recommended `elem` tags
-            , arch `elem` [A_64, A_32] -> lift ($(logError) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|])
+            , arch `elem` [A_64, A_32] -> lift ($(logError) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch))
-        _ -> lift $ $(logWarn) [i|Linux Alpine missing for #{t} #{v'} #{arch'}|]
+        _ -> lift $ $(logWarn) $ "Linux Alpine missing for " <> T.pack (prettyShow t) <> " " <> v' <> " " <> T.pack (prettyShow arch)
 
   checkUniqueTags tool = do
-    let allTags = join $ M.elems $ availableToolVersions dls tool
+    let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
     let nonUnique =
           fmap fst
             .   filter (\(_, b) -> not b)
@@ -143,7 +138,7 @@ validate dls _ = do
     case join nonUnique of
       [] -> pure ()
       xs -> do
-        lift $ $(logError) [i|Tags not unique for #{tool}: #{xs}|]
+        lift $ $(logError) $ "Tags not unique for " <> T.pack (prettyShow tool) <> ": " <> T.pack (prettyShow xs)
         addError
    where
     isUniqueTag Latest         = True
@@ -159,24 +154,24 @@ validate dls _ = do
       case [ x | (x,"") <- readP_to_S V.parseVersion (T.unpack . prettyVer $ v) ] of
         [_] -> pure ()
         _   -> do
-          lift $ $(logError) [i|GHC version #{v} is not valid |]
+          lift $ $(logError) $ "GHC version " <> prettyVer v <> " is not valid"
           addError
 
   -- a tool must have at least one of each mandatory tags
   checkMandatoryTags tool = do
-    let allTags = join $ M.elems $ availableToolVersions dls tool
+    let allTags = join $ fmap _viTags $ M.elems $ availableToolVersions dls tool
     forM_ [Latest, Recommended] $ \t -> case elem t allTags of
       False -> do
-        lift $ $(logError) [i|Tag #{t} missing from #{tool}|]
+        lift $ $(logError) $ "Tag " <> T.pack (prettyShow t) <> " missing from " <> T.pack (prettyShow tool)
         addError
       True -> pure ()
 
   -- all GHC versions must have a base tag
   checkGHCHasBaseVersion = do
     let allTags = M.toList $ availableToolVersions dls GHC
-    forM allTags $ \(ver, tags) -> case any isBase tags of
+    forM allTags $ \(ver, _viTags -> tags) -> case any isBase tags of
       False -> do
-        lift $ $(logError) [i|Base tag missing from GHC ver #{ver}|]
+        lift $ $(logError) $ "Base tag missing from GHC ver " <> prettyVer ver
         addError
       True -> pure ()
 
@@ -209,7 +204,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
     let dlis = either (const []) (\tool -> nubOrd $ dls ^.. each %& indices (maybe (const True) (==) tool) %> each %& indices (matchTest versionRegex . T.unpack . prettyVer) % (viSourceDL % _Just `summing` viArch % each % each % each)) etool
     let gdlis = nubOrd $ gt ^.. each
     let allDls = either (const gdlis) (const dlis) etool
-    when (null allDls) $ $(logError) [i|no tarballs selected by filter|] *> addError
+    when (null allDls) $ $(logError) "no tarballs selected by filter" *> addError
     forM_ allDls downloadAll
 
     -- exit
@@ -217,7 +212,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
     if e > 0
       then pure $ ExitFailure e
       else do
-        lift $ $(logInfo) [i|All good|]
+        lift $ $(logInfo) "All good"
         pure ExitSuccess
 
  where
@@ -237,7 +232,7 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
                   ($(logError) $ T.pack $ prettyShow e)
                 liftIO $ exitWith (ExitFailure 2)
 
-    let appstate = AppState (Settings True False Never Curl False GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
+    let appstate = AppState (Settings True False Never Curl True GHCupURL False) dirs defaultKeyBindings (GHCupInfo mempty mempty mempty) pfreq
 
     r <-
       runLogger
@@ -246,17 +241,13 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
       . runE @'[DigestError
                , DownloadFailed
                , UnknownArchive
-#if defined(TAR)
-               , Tar.FormatError
-#else
                , ArchiveResult
-#endif
                ]
       $ do
         case etool of
           Right (Just GHCup) -> do
             tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download dli tmpUnpack Nothing
+            _ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
             pure Nothing
           Right _ -> do
             p <- liftE $ downloadCached dli Nothing
@@ -266,32 +257,32 @@ validateTarballs (TarballFilter etool versionRegex) dls gt = do
               $ p
           Left ShimGen -> do
             tmpUnpack <- lift mkGhcupTmpDir
-            _ <- liftE $ download dli tmpUnpack Nothing
+            _ <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmpUnpack Nothing False
             pure Nothing
     case r of
       VRight (Just basePath) -> do
         case _dlSubdir dli of
           Just (RealDir prel) -> do
             lift $ $(logInfo)
-              [i|verifying subdir: #{prel}|]
+              $ " verifying subdir: " <> T.pack prel
             when (basePath /= prel) $ do
-              lift $ $(logError)
+              lift $ $(logError) $
-                [i|Subdir doesn't match: expected "#{prel}", got "#{basePath}"|]
+                "Subdir doesn't match: expected " <> T.pack prel <> ", got " <> T.pack basePath
               addError
           Just (RegexDir regexString) -> do
-            lift $ $(logInfo)
+            lift $ $(logInfo) $
-              [i|verifying subdir (regex): #{regexString}|]
+              "verifying subdir (regex): " <> T.pack regexString
             let regex = makeRegexOpts
                   compIgnoreCase
                   execBlank
                   regexString
             when (not (match regex basePath)) $ do
-              lift $ $(logError)
+              lift $ $(logError) $
-                [i|Subdir doesn't match: expected regex "#{regexString}", got "#{basePath}"|]
+                "Subdir doesn't match: expected regex " <> T.pack regexString <> ", got " <> T.pack basePath
               addError
           Nothing -> pure ()
       VRight Nothing -> pure ()
       VLeft  e -> do
-        lift $ $(logError)
+        lift $ $(logError) $
-          [i|Could not download (or verify hash) of #{dli}, Error was: #{prettyShow e}|]
+          "Could not download (or verify hash) of " <> T.pack (show dli) <> ", Error was: " <> T.pack (prettyShow e)
         addError

app/ghcup/BrickMain.hs

@@ -27,9 +27,7 @@ import           Brick.Widgets.List             ( listSelectedFocusedAttr
                                                 , listSelectedAttr
                                                 , listAttr
                                                 )
-#if !defined(TAR)
 import           Codec.Archive
-#endif
 import           Control.Exception.Safe
 import           Control.Monad.Logger
 import           Control.Monad.Reader
@@ -40,7 +38,6 @@ import           Data.Functor
 import           Data.List
 import           Data.Maybe
 import           Data.IORef
-import           Data.String.Interpolate
 import           Data.Vector                    ( Vector
                                                 , (!?)
                                                 )
@@ -428,9 +425,7 @@ install' _ (_, ListResult {..}) = do
           . runResourceT
           . runE
             @'[ AlreadyInstalled
-#if !defined(TAR)
               , ArchiveResult
-#endif
               , UnknownArchive
               , FileDoesNotExistError
               , CopyError
@@ -440,27 +435,29 @@ install' _ (_, ListResult {..}) = do
               , TagNotFound
               , DigestError
               , DownloadFailed
+              , DirNotEmpty
               , NoUpdate
               , TarDirDoesNotExist
+              , FileAlreadyExistsError
               ]
 
   run (do
       case lTool of
         GHC   -> do
           let vi = getVersionInfo lVer GHC dls
-          liftE $ installGHCBin lVer $> vi
+          liftE $ installGHCBin lVer Nothing $> vi
         Cabal -> do
           let vi = getVersionInfo lVer Cabal dls
-          liftE $ installCabalBin lVer $> vi
+          liftE $ installCabalBin lVer Nothing $> vi
         GHCup -> do
           let vi = snd <$> getLatest dls GHCup
           liftE $ upgradeGHCup Nothing False $> vi
         HLS   -> do
           let vi = getVersionInfo lVer HLS dls
-          liftE $ installHLSBin lVer $> vi
+          liftE $ installHLSBin lVer Nothing $> vi
         Stack -> do
           let vi = getVersionInfo lVer Stack dls
-          liftE $ installStackBin lVer $> vi
+          liftE $ installStackBin lVer Nothing $> vi
     )
     >>= \case
           VRight vi                         -> do
@@ -469,8 +466,8 @@ install' _ (_, ListResult {..}) = do
             pure $ Right ()
           VLeft  (V (AlreadyInstalled _ _)) -> pure $ Right ()
           VLeft (V NoUpdate) -> pure $ Right ()
-          VLeft e -> pure $ Left [i|#{prettyShow e}
+          VLeft e -> pure $ Left $ prettyShow e <> "\n"
-Also check the logs in ~/.ghcup/logs|]
+            <> "Also check the logs in ~/.ghcup/logs"
 
 
 set' :: BrickState -> (Int, ListResult) -> IO (Either String ())
@@ -532,8 +529,8 @@ changelog' :: (MonadReader AppState m, MonadIO m)
 changelog' _ (_, ListResult {..}) = do
   AppState { pfreq, ghcupInfo = GHCupInfo { _ghcupDownloads = dls }} <- ask
   case getChangeLog dls lTool (Left lVer) of
-    Nothing -> pure $ Left
+    Nothing -> pure $ Left $
-      [i|Could not find ChangeLog for #{lTool}, version #{prettyVer lVer}|]
+      "Could not find ChangeLog for " <> prettyShow lTool <> ", version " <> T.unpack (prettyVer lVer)
     Just uri -> do
       let cmd = case _rPlatform pfreq of
             Darwin  -> "open"
@@ -599,7 +596,7 @@ brickMain s l = do
           )
         $> ()
     Left e -> do
-      runLogger ($(logError) [i|Error building app state: #{show e}|])
+      runLogger ($(logError) $ "Error building app state: " <> T.pack (show e))
       exitWith $ ExitFailure 2
 
 

app/ghcup/Main.hs

@@ -30,9 +30,7 @@ import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
 import           GHCup.Version
 
-#if !defined(TAR)
 import           Codec.Archive
-#endif
 import           Control.Concurrent
 import           Control.Concurrent.Async
 import           Control.DeepSeq                ( force )
@@ -51,7 +49,6 @@ import           Data.Functor
 import           Data.List                      ( intercalate, nub, sort, sortBy )
 import           Data.List.NonEmpty             (NonEmpty ((:|)))
 import           Data.Maybe
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions           hiding ( str )
 import           Data.Void
@@ -78,6 +75,8 @@ import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
 import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
+import qualified Data.Yaml                     as Y
+import qualified Data.Yaml.Pretty              as YP
 import qualified Text.Megaparsec               as MP
 import qualified Text.Megaparsec.Char          as MPC
 
@@ -105,6 +104,7 @@ data Command
   | Rm (Either RmCommand RmOptions)
   | DInfo
   | Compile CompileCommand
+  | Config ConfigCommand
   | Whereis WhereisOptions WhereisCommand
   | Upgrade UpgradeOpts Bool
   | ToolRequirements
@@ -138,6 +138,7 @@ data InstallOptions = InstallOptions
   , instPlatform :: Maybe PlatformRequest
   , instBindist  :: Maybe URI
   , instSet      :: Bool
+  , isolateDir   :: Maybe FilePath
   }
 
 data SetCommand = SetGHC SetOptions
@@ -173,6 +174,8 @@ data RmOptions = RmOptions
 
 data CompileCommand = CompileGHC GHCCompileOptions
 
+data ConfigCommand = ShowConfig | SetConfig String String | InitConfig
+
 data GHCCompileOptions = GHCCompileOptions
   { targetGhc    :: Either Version GitBranch
   , bootstrapGhc :: Either Version FilePath
@@ -185,6 +188,7 @@ data GHCCompileOptions = GHCCompileOptions
   , ovewrwiteVer :: Maybe Version
   , buildFlavour :: Maybe String
   , hadrian      :: Bool
+  , isolateDir   :: Maybe FilePath
   }
 
 data UpgradeOpts = UpgradeInplace
@@ -408,6 +412,12 @@ com =
                   <> footerDoc (Just $ text changeLogFooter)
                   )
                )
+          <> command
+               "config"
+               (   Config
+               <$> info (configP <**> helper)
+                        (progDesc "Show or set config" <> footerDoc (Just $ text configFooter))
+               )
           <> commandGroup "Other commands:"
           <> hidden
           )
@@ -482,6 +492,17 @@ Examples:
   ghcup prefetch ghc 8.10.5
   ghcup --offline install ghc 8.10.5|]
 
+configFooter :: String
+configFooter = [s|Examples:
+
+# show current config
+ghcup config
+
+# initialize config
+ghcup config init
+
+# set <key> <value> configuration pair
+ghcup config <key> <value>|]
 
 installCabalFooter :: String
 installCabalFooter = [s|Discussion:
@@ -574,7 +595,7 @@ Examples:
 
 installOpts :: Maybe Tool -> Parser InstallOptions
 installOpts tool =
-  (\p (u, v) b -> InstallOptions v p u b)
+  (\p (u, v) b is -> InstallOptions v p u b is)
     <$> optional
           (option
             (eitherReader platformParser)
@@ -603,6 +624,15 @@ installOpts tool =
           (long "set" <> help
             "Set as active version after install"
           )
+    <*> optional
+          (option
+           (eitherReader isolateParser)
+           (  short 'i'
+           <> long "isolate"
+           <> metavar "DIR"
+           <> help "install in an isolated dir instead of the default one"
+           )
+          )
 
 
 setParser :: Parser (Either SetCommand SetOptions)
@@ -786,6 +816,19 @@ Examples:
   # build cross compiler
   ghcup compile ghc -j 4 -v 8.4.2 -b 8.2.2 -x armv7-unknown-linux-gnueabihf --config $(pwd)/build.mk -- --enable-unregisterised|]
 
+configP :: Parser ConfigCommand
+configP = subparser
+      (  command "init" initP
+      <> command "set"  setP -- [set] KEY VALUE at help lhs
+      <> command "show" showP
+      )
+    <|> argsP -- add show for a single option
+    <|> pure ShowConfig
+ where
+  initP = info (pure InitConfig) (progDesc "Write default config to ~/.ghcup/config.yaml")
+  showP = info (pure ShowConfig) (progDesc "Show current config (default)")
+  setP  = info argsP (progDesc "Set config KEY to VALUE")
+  argsP = SetConfig <$> argument str (metavar "KEY") <*> argument str (metavar "VALUE")
 
 whereisP :: Parser WhereisCommand
 whereisP = subparser
@@ -1000,6 +1043,15 @@ ghcCompileOpts =
     <*> switch
           (long "hadrian" <> help "Use the hadrian build system instead of make (only git versions seem to be properly supported atm)"
           )
+    <*> optional
+          (option
+            (eitherReader isolateParser)
+            (  short 'i'
+            <> long "isolate"
+            <> metavar "DIR"
+            <> help "install in an isolated directory instead of the default one, no symlinks to this installation will be made"
+            )
+           )
 
 
 toolVersionParser :: Parser ToolVersion
@@ -1034,7 +1086,7 @@ setVersionArgument criteria tool =
     <|> second SetToolVersion (tVersionEither s')
   parseSet s' = case fmap toLower s' of
                   "next" -> Right SetNext
-                  other  -> Left [i|Unknown tag/version #{other}|]
+                  other  -> Left $ "Unknown tag/version " <> other
 
 
 versionArgument :: Maybe ListCriteria -> Maybe Tool -> Parser GHCTargetVersion
@@ -1061,6 +1113,7 @@ tagCompleter tool add = listIOCompleter $ do
     VRight ghcupInfo -> do
       let allTags = filter (\t -> t /= Old)
             $ join
+            $ fmap _viTags
             $ M.elems
             $ availableToolVersions (_ghcupDownloads ghcupInfo) tool
       pure $ nub $ (add ++) $ fmap tagToString allTags
@@ -1116,8 +1169,8 @@ tagEither s' = case fmap toLower s' of
   "latest"      -> Right Latest
   ('b':'a':'s':'e':'-':ver') -> case pvp (T.pack ver') of
                                   Right x -> Right (Base x)
-                                  Left  _ -> Left [i|Invalid PVP version for base #{ver'}|]
+                                  Left  _ -> Left $ "Invalid PVP version for base " <> ver'
-  other         -> Left [i|Unknown tag #{other}|]
+  other         -> Left $ "Unknown tag " <> other
 
 
 tVersionEither :: String -> Either String GHCTargetVersion
@@ -1214,6 +1267,10 @@ platformParser s' = case MP.parse (platformP <* MP.eof) "" (T.pack s') of
 bindistParser :: String -> Either String URI
 bindistParser = first show . parseURI strictURIParserOptions . UTF8.fromString
 
+isolateParser :: FilePath -> Either String FilePath
+isolateParser f = case isValid f of
+              True -> Right $ normalise f
+              False -> Left "Please enter a valid filepath for isolate dir."
 
 toSettings :: Options -> IO (Settings, KeyBindings)
 toSettings options = do
@@ -1257,6 +1314,21 @@ toSettings options = do
          , bShowAllTools = fromMaybe bShowAllTools kShowAllTools
          }
 
+updateSettings :: Monad m => UTF8.ByteString -> Settings -> Excepts '[JSONError] m Settings
+updateSettings config settings = do
+  settings' <- lE' JSONDecodeError . first show . Y.decodeEither' $ config
+  pure $ mergeConf settings' settings
+  where
+   mergeConf :: UserSettings -> Settings -> Settings
+   mergeConf UserSettings{..} Settings{..} =
+     let cache'      = fromMaybe cache uCache
+         noVerify'   = fromMaybe noVerify uNoVerify
+         keepDirs'   = fromMaybe keepDirs uKeepDirs
+         downloader' = fromMaybe downloader uDownloader
+         verbose'    = fromMaybe verbose uVerbose
+         urlSource'  = fromMaybe urlSource uUrlSource
+         noNetwork'  = fromMaybe noNetwork uNoNetwork
+     in Settings cache' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork'
 
 upgradeOptsP :: Parser UpgradeOpts
 upgradeOptsP =
@@ -1291,6 +1363,11 @@ describe_result = $( LitE . StringL <$>
                      )
                    )
 
+formatConfig :: UserSettings -> String
+formatConfig settings
+  = UTF8.toString . YP.encodePretty yamlConfig $ settings
+ where
+  yamlConfig = YP.setConfCompare compare YP.defConfig
 
 main :: IO ()
 main = do
@@ -1388,9 +1465,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 let s' = AppState settings dirs keybindings ghcupInfo pfreq
 
                 race_ (liftIO $ runLogger $ flip runReaderT dirs $ cleanupTrash)
-                      (threadDelay 5000000 >> runLogger ($(logWarn) [i|Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in #{recycleDir} manually|]))
+                      (threadDelay 5000000 >> runLogger ($(logWarn) $ "Killing cleanup thread (exceeded 5s timeout)... please remove leftover files in " <> T.pack recycleDir <> " manually"))
 
-                lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
+                case optCommand of
+                  Nuke -> pure ()
+                  Whereis _ _ -> pure ()
+                  DInfo -> pure ()
+                  ToolRequirements -> pure ()
+                  ChangeLog _ -> pure ()
+#if defined(BRICK)
+                  Interactive -> pure ()
+#endif
+                  _ -> lookupEnv "GHCUP_SKIP_UPDATE_CHECK" >>= \case
                          Nothing -> runLogger $ flip runReaderT s' $ checkForUpdates
                          Just _ -> pure ()
 
@@ -1430,11 +1516,11 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   . runE
                     @'[ AlreadyInstalled
                       , UnknownArchive
-#if !defined(TAR)
                       , ArchiveResult
-#endif
                       , FileDoesNotExistError
                       , CopyError
+                      , NotInstalled
+                      , DirNotEmpty
                       , NoDownload
                       , NotInstalled
                       , BuildFailed
@@ -1444,6 +1530,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , TarDirDoesNotExist
                       , NextVerNotFound
                       , NoToolVersionSet
+                      , FileAlreadyExistsError
                       ]
 
           let runInstTool mInstPlatform action' = do
@@ -1545,9 +1632,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                       , UnknownArchive
                       , TarDirDoesNotExist
                       , NotInstalled
-#if !defined(TAR)
+                      , DirNotEmpty
                       , ArchiveResult
-#endif
                       ]
 
           let
@@ -1610,7 +1696,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 (case instBindist of
                    Nothing -> runInstTool instPlatform $ do
                      (v, vi) <- liftE $ fromVersion instVer GHC
-                       liftE $ installGHCBin (_tvVersion v)
+                     liftE $ installGHCBin (_tvVersion v) isolateDir
                      when instSet $ void $ liftE $ setGHC v SetGHCOnly
                      pure vi
                    Just uri -> do
@@ -1620,6 +1706,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                        liftE $ installGHCBindist
                          (DownloadInfo uri (Just $ RegexDir "ghc-.*") "")
                          (_tvVersion v)
+                         isolateDir
                        when instSet $ void $ liftE $ setGHC v SetGHCOnly
                        pure vi
                   )
@@ -1630,20 +1717,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                               runLogger $ $(logInfo) msg
                             pure ExitSuccess
                           VLeft (V (AlreadyInstalled _ v)) -> do
-                            runLogger $ $(logWarn)
+                            runLogger $ $(logWarn) $
-                              [i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
+                              "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
                             pure ExitSuccess
                           VLeft err@(V (BuildFailed tmpdir _)) -> do
                             case keepDirs settings of
                               Never -> myLoggerT loggerConfig $ ($(logError) $ T.pack $ prettyShow err)
-                              _ -> myLoggerT loggerConfig $ ($(logError) [i|#{prettyShow err}
+                              _ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <>
-    Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
+                                "Check the logs at " <> T.pack logsDir <> " and the build directory " <> T.pack tmpdir <> " for more clues." <> "\n" <>
-    Make sure to clean up #{tmpdir} afterwards.|])
+                                "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                             pure $ ExitFailure 3
                           VLeft e -> do
                             runLogger $ do
                               $(logError) $ T.pack $ prettyShow e
-                              $(logError) [i|Also check the logs in #{logsDir}|]
+                              $(logError) $ "Also check the logs in " <> T.pack logsDir
                             pure $ ExitFailure 3
 
 
@@ -1651,7 +1738,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 (case instBindist of
                    Nothing -> runInstTool instPlatform $ do
                      (v, vi) <- liftE $ fromVersion instVer Cabal
-                     liftE $ installCabalBin (_tvVersion v)
+                     liftE $ installCabalBin (_tvVersion v) isolateDir
                      pure vi
                    Just uri -> do
                      s' <- appState
@@ -1660,6 +1747,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                        liftE $ installCabalBindist
                            (DownloadInfo uri Nothing "")
                            (_tvVersion v)
+                           isolateDir
                        pure vi
                   )
                   >>= \case
@@ -1669,20 +1757,20 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft (V (AlreadyInstalled _ v)) -> do
-                          runLogger $ $(logWarn)
+                          runLogger $ $(logWarn) $
-                            [i|Cabal ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal #{prettyVer v}' first|]
+                            "Cabal ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm cabal " <> prettyVer v <> "' first"
                           pure ExitSuccess
                         VLeft e -> do
                           runLogger $ do
                             $(logError) $ T.pack $ prettyShow e
-                            $(logError) [i|Also check the logs in #{logsDir}|]
+                            $(logError) $ "Also check the logs in " <> T.pack logsDir
                           pure $ ExitFailure 4
 
           let installHLS InstallOptions{..} =
                  (case instBindist of
                    Nothing -> runInstTool instPlatform $ do
                      (v, vi) <- liftE $ fromVersion instVer HLS
-                     liftE $ installHLSBin (_tvVersion v)
+                     liftE $ installHLSBin (_tvVersion v) isolateDir
                      pure vi
                    Just uri -> do
                      s' <- appState
@@ -1691,6 +1779,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                        liftE $ installHLSBindist
                            (DownloadInfo uri Nothing "")
                            (_tvVersion v)
+                           isolateDir
                        pure vi
                   )
                   >>= \case
@@ -1700,20 +1789,24 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft (V (AlreadyInstalled _ v)) -> do
-                          runLogger $ $(logWarn)
+                          runLogger $ $(logWarn) $
-                            [i|HLS ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls #{prettyVer v}' first|]
+                              "HLS ver "
+                            <> prettyVer v
+                            <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm hls "
+                            <> prettyVer v
+                            <> "' first"
                           pure ExitSuccess
                         VLeft e -> do
                           runLogger $ do
                             $(logError) $ T.pack $ prettyShow e
-                            $(logError) [i|Also check the logs in #{logsDir}|]
+                            $(logError) $ "Also check the logs in " <> T.pack logsDir
                           pure $ ExitFailure 4
 
           let installStack InstallOptions{..} =
                  (case instBindist of
                     Nothing -> runInstTool instPlatform $ do
                       (v, vi) <- liftE $ fromVersion instVer Stack
-                     liftE $ installStackBin (_tvVersion v)
+                      liftE $ installStackBin (_tvVersion v) isolateDir
                       pure vi
                     Just uri -> do
                       s' <- appState
@@ -1722,6 +1815,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                         liftE $ installStackBindist
                             (DownloadInfo uri Nothing "")
                             (_tvVersion v)
+                            isolateDir
                         pure vi
                   )
                   >>= \case
@@ -1731,13 +1825,13 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             runLogger $ $(logInfo) msg
                           pure ExitSuccess
                         VLeft (V (AlreadyInstalled _ v)) -> do
-                          runLogger $ $(logWarn)
+                          runLogger $ $(logWarn) $
-                            [i|Stack ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack #{prettyVer v}' first|]
+                            "Stack ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm stack " <> prettyVer v <> "' first"
                           pure ExitSuccess
                         VLeft e -> do
                           runLogger $ do
                             $(logError) $ T.pack $ prettyShow e
-                            $(logError) [i|Also check the logs in #{logsDir}|]
+                            $(logError) $ "Also check the logs in " <> T.pack logsDir
                           pure $ ExitFailure 4
 
 
@@ -1751,8 +1845,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight GHCTargetVersion{..} -> do
                           runLogger
-                            $ $(logInfo)
+                            $ $(logInfo) $
-                                [i|GHC #{prettyVer _tvVersion} successfully set as default version#{maybe "" (" for cross target " <>) _tvTarget}|]
+                                "GHC " <> prettyVer _tvVersion <> " successfully set as default version" <> maybe "" (" for cross target " <>) _tvTarget
                           pure ExitSuccess
                         VLeft e -> do
                           runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -1769,8 +1863,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight GHCTargetVersion{..} -> do
                           runLogger
-                            $ $(logInfo)
+                            $ $(logInfo) $
-                                [i|Cabal #{prettyVer _tvVersion} successfully set as default version|]
+                                "Cabal " <> prettyVer _tvVersion <> " successfully set as default version"
                           pure ExitSuccess
                         VLeft  e -> do
                           runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -1787,8 +1881,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight GHCTargetVersion{..} -> do
                           runLogger
-                            $ $(logInfo)
+                            $ $(logInfo) $
-                                [i|HLS #{prettyVer _tvVersion} successfully set as default version|]
+                                "HLS " <> prettyVer _tvVersion <> " successfully set as default version"
                           pure ExitSuccess
                         VLeft  e -> do
                           runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -1805,8 +1899,8 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                   >>= \case
                         VRight GHCTargetVersion{..} -> do
                           runLogger
-                            $ $(logInfo)
+                            $ $(logInfo) $
-                                [i|Stack #{prettyVer _tvVersion} successfully set as default version|]
+                                "Stack " <> prettyVer _tvVersion <> " successfully set as default version"
                           pure ExitSuccess
                         VLeft  e -> do
                           runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -1883,18 +1977,18 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
               liftIO $ brickMain s' loggerConfig >> pure ExitSuccess
 #endif
             Install (Right iopts) -> do
-              runLogger ($(logWarn) [i|This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.|])
+              runLogger ($(logWarn) "This is an old-style command for installing GHC. Use 'ghcup install ghc' instead.")
               installGHC iopts
             Install (Left (InstallGHC iopts)) -> installGHC iopts
             Install (Left (InstallCabal iopts)) -> installCabal iopts
             Install (Left (InstallHLS iopts)) -> installHLS iopts
             Install (Left (InstallStack iopts)) -> installStack iopts
             InstallCabalLegacy iopts -> do
-              runLogger ($(logWarn) [i|This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.|])
+              runLogger ($(logWarn) "This is an old-style command for installing cabal. Use 'ghcup install cabal' instead.")
               installCabal iopts
 
             Set (Right sopts) -> do
-              runLogger ($(logWarn) [i|This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.|])
+              runLogger ($(logWarn) "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
               setGHC' sopts
             Set (Left (SetGHC sopts)) -> setGHC' sopts
             Set (Left (SetCabal sopts)) -> setCabal' sopts
@@ -1909,7 +2003,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                 )
 
             Rm (Right rmopts) -> do
-              runLogger ($(logWarn) [i|This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.|])
+              runLogger ($(logWarn) "This is an old-style command for removing GHC. Use 'ghcup rm ghc' instead.")
               rmGHC' rmopts
             Rm (Left (RmGHC rmopts)) -> rmGHC' rmopts
             Rm (Left (RmCabal rmopts)) -> rmCabal' rmopts
@@ -1951,6 +2045,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                             addConfArgs
                             buildFlavour
                             hadrian
+                            isolateDir
                 GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
                 let vi = getVersionInfo (_tvVersion targetVer) GHC dls
                 when setCompile $ void $ liftE $
@@ -1966,20 +2061,51 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
                         putStr (T.unpack $ tVerToText tv)
                         pure ExitSuccess
                       VLeft (V (AlreadyInstalled _ v)) -> do
-                        runLogger $ $(logWarn)
+                        runLogger $ $(logWarn) $
-                          [i|GHC ver #{prettyVer v} already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc #{prettyVer v}' first|]
+                          "GHC ver " <> prettyVer v <> " already installed; if you really want to reinstall it, you may want to run 'ghcup rm ghc " <> prettyVer v <> "' first"
                         pure ExitSuccess
                       VLeft err@(V (BuildFailed tmpdir _)) -> do
                         case keepDirs settings of
                           Never -> myLoggerT loggerConfig $ $(logError) $ T.pack $ prettyShow err
-                          _ -> myLoggerT loggerConfig $ ($(logError) [i|#{prettyShow err}
+                          _ -> myLoggerT loggerConfig $ ($(logError) $ T.pack (prettyShow err) <> "\n" <>
-Check the logs at #{logsDir} and the build directory #{tmpdir} for more clues.
+                                "Check the logs at " <> T.pack logsDir <> " and the build directory "
-Make sure to clean up #{tmpdir} afterwards.|])
+                                <> T.pack tmpdir <> " for more clues." <> "\n" <>
+                                "Make sure to clean up " <> T.pack tmpdir <> " afterwards.")
                         pure $ ExitFailure 9
                       VLeft e -> do
                         runLogger $ $(logError) $ T.pack $ prettyShow e
                         pure $ ExitFailure 9
 
+            Config InitConfig -> do
+              path <- getConfigFilePath
+              writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
+              runLogger $ $(logDebug) $ "config.yaml initialized at " <> T.pack path
+              pure ExitSuccess
+
+            Config ShowConfig -> do
+              putStrLn $ formatConfig $ fromSettings settings (Just keybindings)
+              pure ExitSuccess
+
+            Config (SetConfig k v) -> do
+              case v of
+                "" -> do
+                  runLogger $ $(logError) "Empty values are not allowed"
+                  pure $ ExitFailure 55
+                _  -> do
+                  r <- runE @'[JSONError] $ do
+                    settings' <- updateSettings (UTF8.fromString (k <> ": " <> v <> "\n")) settings
+                    path <- liftIO getConfigFilePath
+                    liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
+                    runLogger $ $(logDebug) $ T.pack $ show settings'
+                    pure ()
+
+                  case r of
+                      VRight _ -> pure ExitSuccess
+                      VLeft (V (JSONDecodeError e)) -> do
+                        runLogger $ $(logError) $ "Error decoding config: " <> T.pack e
+                        pure $ ExitFailure 65
+                      VLeft _ -> pure $ ExitFailure 65
+
             Whereis WhereisOptions{..} (WhereisTool tool (Just (ToolVersion v))) ->
               runLeanWhereIs (do
                 loc <- liftE $ whereIsTool tool v
@@ -2017,18 +2143,21 @@ Make sure to clean up #{tmpdir} afterwards.|])
                 (UpgradeAt p)   -> pure $ Just p
                 UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
 
-              runUpgrade (liftE $ upgradeGHCup target force') >>= \case
+              runUpgrade (do
-                VRight v' -> do
+                v' <- liftE $ upgradeGHCup target force'
-                  GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo
+                GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
+                pure (v', dls)
+                ) >>= \case
+                  VRight (v', dls) -> do
                     let pretty_v = prettyVer v'
                     let vi = fromJust $ snd <$> getLatest dls GHCup
-                  runLogger $ $(logInfo)
+                    runLogger $ $(logInfo) $
-                    [i|Successfully upgraded GHCup to version #{pretty_v}|]
+                      "Successfully upgraded GHCup to version " <> pretty_v
                     forM_ (_viPostInstall vi) $ \msg ->
                       runLogger $ $(logInfo) msg
                     pure ExitSuccess
                   VLeft (V NoUpdate) -> do
-                  runLogger $ $(logWarn) [i|No GHCup update available|]
+                    runLogger $ $(logWarn) "No GHCup update available"
                     pure ExitSuccess
                   VLeft e -> do
                     runLogger $ $(logError) $ T.pack $ prettyShow e
@@ -2066,8 +2195,8 @@ Make sure to clean up #{tmpdir} afterwards.|])
               case muri of
                 Nothing -> do
                   runLogger
-                    ($(logWarn)
+                    ($(logWarn) $
-                      [i|Could not find ChangeLog for #{tool}, version #{either (T.unpack . prettyVer) show ver'}|]
+                      "Could not find ChangeLog for " <> T.pack (prettyShow tool) <> ", version " <> either prettyVer (T.pack . show) ver'
                     )
                   pure ExitSuccess
                 Just uri -> do
@@ -2089,7 +2218,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
                              Nothing
                           >>= \case
                                 Right _ -> pure ExitSuccess
-                                Left  e -> runLogger ($(logError) [i|#{e}|])
+                                Left  e -> runLogger ($(logError) (T.pack $ prettyShow e))
                                   >> pure (ExitFailure 13)
                     else putStrLn uri' >> pure ExitSuccess
 
@@ -2116,7 +2245,7 @@ Make sure to clean up #{tmpdir} afterwards.|])
                                   runLogger $ $logInfo "Nuclear Annihilation complete!"
                                   pure ExitSuccess
                               | otherwise -> do
-                                  runLogger $ $logWarn "These Files have survived Nuclear Annihilation, you may remove them manually."
+                                  runLogger $ $logError "These Files have survived Nuclear Annihilation, you may remove them manually."
                                   forM_ leftOverFiles putStrLn
                                   pure ExitSuccess
 
@@ -2442,46 +2571,46 @@ checkForUpdates = do
   forM_ (getLatest dls GHCup) $ \(l, _) -> do
     (Right ghc_ver) <- pure $ version $ prettyPVP ghcUpVer
     when (l > ghc_ver)
-      $ $(logWarn)
+      $ $(logWarn) $
-          [i|New GHCup version available: #{prettyVer l}. To upgrade, run 'ghcup upgrade'|]
+          "New GHCup version available: " <> prettyVer l <> ". To upgrade, run 'ghcup upgrade'"
 
   forM_ (getLatest dls GHC) $ \(l, _) -> do
     let mghc_ver = latestInstalled GHC
     forM mghc_ver $ \ghc_ver ->
       when (l > ghc_ver)
-        $ $(logWarn)
+        $ $(logWarn) $
-            [i|New GHC version available: #{prettyVer l}. To upgrade, run 'ghcup install ghc #{prettyVer l}'|]
+          "New GHC version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install ghc " <> prettyVer l <> "'"
 
   forM_ (getLatest dls Cabal) $ \(l, _) -> do
     let mcabal_ver = latestInstalled Cabal
     forM mcabal_ver $ \cabal_ver ->
       when (l > cabal_ver)
-        $ $(logWarn)
+        $ $(logWarn) $
-            [i|New Cabal version available: #{prettyVer l}. To upgrade, run 'ghcup install cabal #{prettyVer l}'|]
+          "New Cabal version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install cabal " <> prettyVer l <> "'"
 
   forM_ (getLatest dls HLS) $ \(l, _) -> do
     let mhls_ver = latestInstalled HLS
     forM mhls_ver $ \hls_ver ->
       when (l > hls_ver)
-        $ $(logWarn)
+        $ $(logWarn) $
-            [i|New HLS version available: #{prettyVer l}. To upgrade, run 'ghcup install hls #{prettyVer l}'|]
+          "New HLS version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install hls " <> prettyVer l <> "'"
 
   forM_ (getLatest dls Stack) $ \(l, _) -> do
     let mstack_ver = latestInstalled Stack
     forM mstack_ver $ \stack_ver ->
       when (l > stack_ver)
-        $ $(logWarn)
+        $ $(logWarn) $
-            [i|New Stack version available: #{prettyVer l}. To upgrade, run 'ghcup install stack #{prettyVer l}'|]
+          "New Stack version available: " <> prettyVer l <> ". To upgrade, run 'ghcup install stack " <> prettyVer l <> "'"
 
 
 prettyDebugInfo :: DebugInfo -> String
-prettyDebugInfo DebugInfo {..} = [i|Debug Info
+prettyDebugInfo DebugInfo {..} = "Debug Info" <> "\n" <>
-==========
+  "==========" <> "\n" <>
-GHCup base dir: #{diBaseDir}
+  "GHCup base dir: " <> diBaseDir <> "\n" <>
-GHCup bin dir: #{diBinDir}
+  "GHCup bin dir: " <> diBinDir <> "\n" <>
-GHCup GHC directory: #{diGHCDir}
+  "GHCup GHC directory: " <> diGHCDir <> "\n" <>
-GHCup cache directory: #{diCacheDir}
+  "GHCup cache directory: " <> diCacheDir <> "\n" <>
-Architecture: #{prettyShow diArch}
+  "Architecture: " <> prettyShow diArch <> "\n" <>
-Platform: #{prettyShow diPlatform}
+  "Platform: " <> prettyShow diPlatform <> "\n" <>
-Version: #{describe_result}|]
+  "Version: " <> describe_result
 

bootstrap-haskell

@@ -20,7 +20,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.15.2"
+ghver="0.1.16.2"
 base_url="https://downloads.haskell.org/~ghcup"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -275,6 +275,8 @@ find_shell() {
 ask_bashrc() {
 	if [ -n "${BOOTSTRAP_HASKELL_ADJUST_BASHRC}" ] ; then
 		return 1
+	elif [ -z "${MY_SHELL}" ] ; then
+		return 0
 	fi
 
 	while true; do

bootstrap-haskell.ps1

@@ -158,6 +158,26 @@ $ErrorActionPreference = 'Stop'
 
 $GhcupBasePrefixEnv = [System.Environment]::GetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', 'user')
 
+if (Get-Command -Name 'chocolatey.exe' -ErrorAction SilentlyContinue) {
+  if (!($Silent)) {
+    Print-Msg -color Magenta -msg (@'
+Chocolatey was detected on your system. It is capable of installing the Haskell toolchain as well.
+If you want to rather use that instead of ghcup, abort the installation and run the following at an
+elevated command prompt:
+    choco install haskell-dev
+    refreshenv
+
+'@)
+    $decision = $Host.UI.PromptForChoice(''
+    , 'Continue with GHCup installation?'
+    , [System.Management.Automation.Host.ChoiceDescription[]] @('&Continue'
+        '&Abort'), 0)
+    if ($decision -eq 1) {
+      Exit 0
+    }
+  }
+}
+
 if ($GhcupBasePrefixEnv) {
   $defaultGhcupBasePrefix = $GhcupBasePrefixEnv
 } else {
@@ -276,7 +296,7 @@ if ($CabalDir) {
   while ($true) {
 
     $defaultCabalDir = ('{0}\cabal' -f $GhcupBasePrefix)
-    Print-Msg -color Magenta -msg ('Specify Cabal directory (this is where haskell packages end up). Press enter to accept the default [{0}]:' -f $defaultCabalDir)
+    Print-Msg -color Magenta -msg ('Specify Cabal directory (this is where haskell packages end up){1}Press enter to accept the default [{0}]:' -f $defaultCabalDir, "`n")
     $CabalDirPrompt = Read-Host
     $CabDirEnv = ($defaultCabalDir,$CabalDirPrompt)[[bool]$CabalDirPrompt]
 
@@ -371,7 +391,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
     Exec "$Bash" '-lc' 'pacman --noconfirm -Syuu'
 
     Print-Msg -msg 'Installing Dependencies...'
-    Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl mingw-w64-x86_64-pkgconf'
+    Exec "$Bash" '-lc' 'pacman --noconfirm -S --needed curl autoconf mingw-w64-x86_64-pkgconf'
 
     Print-Msg -msg 'Updating SSL root certificate authorities...'
     Exec "$Bash" '-lc' 'pacman --noconfirm -S ca-certificates'
@@ -383,7 +403,7 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
     while ($true) {
       if ($GhcupMsys2) {
         $defaultMsys2Dir = $GhcupMsys2
-        Print-Msg -color Magenta -msg ('Input existing MSys2 toolchain directory. Press enter to accept the default [{0}]:' -f $defaultMsys2Dir)
+        Print-Msg -color Magenta -msg ('Input existing MSys2 toolchain directory.{1}Press enter to accept the default [{0}]:' -f $defaultMsys2Dir, "`n")
         $MsysDirPrompt = Read-Host
         $MsysDir = ($defaultMsys2Dir,$MsysDirPrompt)[[bool]$MsysDirPrompt]
       } else {
@@ -412,11 +432,74 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 }
 
 Print-Msg -msg 'Creating shortcuts...'
+$uninstallShortCut = @'
+$decision = $Host.UI.PromptForChoice('Uninstall Haskell'
+, 'Do you want to uninstall all of the haskell toolchain, including GHC, Cabal, Stack and GHCup itself?'
+, [System.Management.Automation.Host.ChoiceDescription[]] @('&Uninstall'
+    '&Abort'), 0)
+
+if ($decision -eq 1) {
+  Exit 0
+}
+
+Write-Host 'Removing ghcup toolchain' -ForegroundColor Green
+ghcup nuke
+
+Write-Host 'Unsetting GHCUP_INSTALL_BASE_PREFIX' -ForegroundColor Green
+[Environment]::SetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', $null, [System.EnvironmentVariableTarget]::User)
+
+$ghcupMsys2 = [System.Environment]::GetEnvironmentVariable('GHCUP_MSYS2', 'user')
+$GhcupBasePrefixEnv = [System.Environment]::GetEnvironmentVariable('GHCUP_INSTALL_BASE_PREFIX', 'user')
+
+if ($ghcupMsys2) {
+  $msys2Dir = [IO.Path]::GetFullPath($ghcupMsys2)
+  $baseDir = [IO.Path]::GetFullPath('{0}\ghcup' -f $GhcupBasePrefixEnv)
+
+  if ($msys2Dir.StartsWith($baseDir)) {
+    Write-Host 'Unsetting GHCUP_MSYS2' -ForegroundColor Green
+    [Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)
+  } else {
+    Write-Host ('GHCUP_MSYS2 env variable is set to a non-standard location {0}. Environment variable not unset. Uninstall manually.' -f $msys2Dir) -ForegroundColor Magenta
+  }
+} else {
+  Write-Host 'Unsetting GHCUP_MSYS2' -ForegroundColor Green
+  [Environment]::SetEnvironmentVariable('GHCUP_MSYS2', $null, [System.EnvironmentVariableTarget]::User)
+}
+
+Write-Host 'Removing ghcup from PATH env var' -ForegroundColor Green
+$path = [System.Environment]::GetEnvironmentVariable(
+    'PATH',
+    'user'
+)
+$path = ($path.Split(';') | Where-Object { $_ -ne ('{0}\bin' -f $baseDir) }) -join ';'
+[System.Environment]::SetEnvironmentVariable(
+    'PATH',
+    $path,
+    'user'
+)
+
+Write-Host 'Removing desktop files' -ForegroundColor Green
+$DesktopDir = [Environment]::GetFolderPath("Desktop")
+Remove-Item -LiteralPath ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir) -Force
+Remove-Item -LiteralPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir) -Force
+Remove-Item -LiteralPath ('{0}\Mingw package management docs.url' -f $DesktopDir) -Force
+
+Write-Host ('CABAL_DIR env variable is still set to {0} and will be used by cabal regardless of ghcup. You may want to uninstall this manually.' -f [System.Environment]::GetEnvironmentVariable('CABAL_DIR', 'user')) -ForegroundColor Magenta
+Write-Host 'You may remove this script now.' -ForegroundColor Magenta
+
+if ($Host.Name -eq "ConsoleHost")
+{
+    Write-Host "Press any key to continue..."
+    $Host.UI.RawUI.ReadKey("NoEcho,IncludeKeyUp") > $null
+}
+'@
+
 $DesktopDir = [Environment]::GetFolderPath("Desktop")
 $GhcInstArgs = '-mingw64 -mintty -c "pacman --noconfirm -S --needed base-devel gettext autoconf make libtool automake python p7zip patch unzip"'
 Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe $GhcInstArgs -DestinationPath ('{0}\Install GHC dev dependencies.lnk' -f $DesktopDir)
 Create-Shortcut -SourceExe ('{0}\msys2_shell.cmd' -f $MsysDir) -ArgumentsToSourceExe '-mingw64' -DestinationPath ('{0}\Mingw haskell shell.lnk' -f $DesktopDir)
 Create-Shortcut -SourceExe 'https://www.msys2.org/docs/package-management' -ArgumentsToSourceExe '' -DestinationPath ('{0}\Mingw package management docs.url' -f $DesktopDir)
+$null = New-Item -Path $DesktopDir -Name "Uninstall Haskell.ps1" -ItemType "file" -Force -Value $uninstallShortCut
 
 Print-Msg -msg ('Adding {0}\bin to Users Path...' -f $GhcupDir)
 Add-EnvPath -Path ('{0}\bin' -f ([System.IO.Path]::GetFullPath("$GhcupDir"))) -Container 'User'

cabal.ghc8105.project

@@ -8,6 +8,11 @@ package ghcup
     tests: True
     flags: +tui
 
+source-repository-package
+    type: git
+    location: https://github.com/jtdaugherty/brick.git
+    tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
+
 source-repository-package
     type: git
     location: https://github.com/Bodigrim/tar

cabal.ghc8105.project.freeze

@@ -5,7 +5,7 @@ constraints: any.Cabal ==3.2.1.0,
              HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
              any.QuickCheck ==2.14.2,
              QuickCheck -old-random +templatehaskell,
-             any.StateVar ==1.2.1,
+             any.StateVar ==1.2.2,
              any.aeson ==1.5.6.0,
              aeson -bytestring-builder -cffi -developer -fast,
              any.aeson-pretty ==0.8.8,
@@ -34,7 +34,7 @@ constraints: any.Cabal ==3.2.1.0,
              any.binary ==0.8.8.0,
              any.bindings-DSL ==1.0.25,
              any.blaze-builder ==0.4.2.1,
-             any.brick ==0.61,
+             any.brick ==0.63,
              brick -demos,
              any.bytestring ==0.10.12.0,
              any.bz2 ==1.0.1.0,
@@ -66,7 +66,7 @@ constraints: any.Cabal ==3.2.1.0,
              any.config-ini ==0.2.4.0,
              config-ini -enable-doctests,
              any.containers ==0.6.4.1,
-             any.contravariant ==1.5.3,
+             any.contravariant ==1.5.4,
              contravariant +semigroups +statevar +tagged,
              any.cpphs ==1.20.9.1,
              cpphs -old-locale,
@@ -111,7 +111,7 @@ constraints: any.Cabal ==3.2.1.0,
              hsc2hs -in-ghc-tree,
              any.hspec ==2.7.10,
              any.hspec-core ==2.7.10,
-             any.hspec-discover ==2.7.10,
+             any.hspec-discover ==2.7.10 || ==2.8.2,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
@@ -137,7 +137,7 @@ constraints: any.Cabal ==3.2.1.0,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
              any.microlens-th ==0.4.3.10,
-             any.monad-control ==1.0.2.3,
+             any.monad-control ==1.0.3,
              any.monad-logger ==0.3.36,
              monad-logger +template_haskell,
              any.monad-loops ==0.4.3,
@@ -176,7 +176,7 @@ constraints: any.Cabal ==3.2.1.0,
              any.recursion-schemes ==5.2.2.1,
              recursion-schemes +template-haskell,
              any.regex-base ==0.94.0.1,
-             any.regex-posix ==0.96.0.0,
+             any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
              any.resourcet ==1.2.4.2,
              any.rts ==1.0.1,
@@ -228,7 +228,7 @@ constraints: any.Cabal ==3.2.1.0,
              any.transformers ==0.5.6.2,
              any.transformers-base ==0.4.5.2,
              transformers-base +orphaninstances,
-             any.transformers-compat ==0.6.6,
+             any.transformers-compat ==0.7,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
              any.typed-process ==0.2.6.0,
              any.unix ==2.7.2.2,
@@ -261,4 +261,4 @@ constraints: any.Cabal ==3.2.1.0,
              any.zlib-bindings ==0.1.1.5,
              any.zstd ==0.1.2.0,
              zstd +standalone
-index-state: hackage.haskell.org 2021-07-12T18:00:24Z
+index-state: hackage.haskell.org 2021-07-27T07:59:57Z

cabal.ghc901.project

@@ -8,6 +8,11 @@ package ghcup
     tests: True
     flags: +tui
 
+source-repository-package
+    type: git
+    location: https://github.com/jtdaugherty/brick.git
+    tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
+
 source-repository-package
     type: git
     location: https://github.com/Bodigrim/tar

cabal.ghc901.project.freeze

@@ -5,7 +5,7 @@ constraints: any.Cabal ==3.4.0.0,
              HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
              any.QuickCheck ==2.14.2,
              QuickCheck -old-random +templatehaskell,
-             any.StateVar ==1.2.1,
+             any.StateVar ==1.2.2,
              any.aeson ==1.5.6.0,
              aeson -bytestring-builder -cffi -developer -fast,
              any.aeson-pretty ==0.8.8,
@@ -34,7 +34,7 @@ constraints: any.Cabal ==3.4.0.0,
              any.binary ==0.8.8.0,
              any.bindings-DSL ==1.0.25,
              any.blaze-builder ==0.4.2.1,
-             any.brick ==0.61,
+             any.brick ==0.63,
              brick -demos,
              any.bytestring ==0.10.12.1,
              any.bz2 ==1.0.1.0,
@@ -66,7 +66,7 @@ constraints: any.Cabal ==3.4.0.0,
              any.config-ini ==0.2.4.0,
              config-ini -enable-doctests,
              any.containers ==0.6.4.1,
-             any.contravariant ==1.5.3,
+             any.contravariant ==1.5.4,
              contravariant +semigroups +statevar +tagged,
              any.cpphs ==1.20.9.1,
              cpphs -old-locale,
@@ -112,7 +112,7 @@ constraints: any.Cabal ==3.4.0.0,
              hsc2hs -in-ghc-tree,
              any.hspec ==2.7.10,
              any.hspec-core ==2.7.10,
-             any.hspec-discover ==2.7.10,
+             any.hspec-discover ==2.7.10 || ==2.8.2,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.0,
@@ -137,7 +137,7 @@ constraints: any.Cabal ==3.4.0.0,
              any.microlens ==0.4.12.0,
              any.microlens-mtl ==0.2.0.1,
              any.microlens-th ==0.4.3.10,
-             any.monad-control ==1.0.2.3,
+             any.monad-control ==1.0.3,
              any.monad-logger ==0.3.36,
              monad-logger +template_haskell,
              any.monad-loops ==0.4.3,
@@ -176,7 +176,7 @@ constraints: any.Cabal ==3.4.0.0,
              any.recursion-schemes ==5.2.2.1,
              recursion-schemes +template-haskell,
              any.regex-base ==0.94.0.1,
-             any.regex-posix ==0.96.0.0,
+             any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
              any.resourcet ==1.2.4.2,
              any.rts ==1.0,
@@ -228,7 +228,7 @@ constraints: any.Cabal ==3.4.0.0,
              any.transformers ==0.5.6.2,
              any.transformers-base ==0.4.5.2,
              transformers-base +orphaninstances,
-             any.transformers-compat ==0.6.6,
+             any.transformers-compat ==0.7,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
              any.typed-process ==0.2.6.0,
              any.unix ==2.7.2.2,
@@ -261,4 +261,4 @@ constraints: any.Cabal ==3.4.0.0,
              any.zlib-bindings ==0.1.1.5,
              any.zstd ==0.1.2.0,
              zstd +standalone
-index-state: hackage.haskell.org 2021-07-12T18:00:24Z
+index-state: hackage.haskell.org 2021-07-27T07:59:57Z

cabal.project

@@ -8,21 +8,16 @@ package ghcup
     tests: True
     flags: +tui
 
-source-repository-package
-    type: git
-    location: https://github.com/jtdaugherty/brick.git
-    tag: b3b96cfe66dfd398d338e3feb2b6855e66a35190
-
-source-repository-package
-    type: git
-    location: https://github.com/Bodigrim/tar
-    tag: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
-
 source-repository-package
     type: git
     location: https://github.com/bgamari/terminal-size
     tag: 34ea816bd63f75f800eedac12c6908c6f3736036
 
+source-repository-package
+    type: git
+    location: https://github.com/hasufell/libarchive
+    tag: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
+
 constraints: http-io-streams -brotli
 
 package libarchive

ghcup-0.0.2.yaml

@@ -1384,7 +1384,7 @@ ghcupDownloads:
               dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
               dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
   GHCup:
-    0.1.14:
+    0.1.16.2:
       viTags:
       - Recommended
       - Latest
@@ -1394,22 +1394,22 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-linux-ghcup-0.1.14
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2
-              dlHash: e9b314d248f4d4604ce64cee1be7161c77c8940efd11986c9205779ec3b598dd
+              dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-apple-darwin-ghcup-0.1.14
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2
-              dlHash: 69ede9db36c0ae631b679fceb87dd856d4753ee26f33610da37dd7a694809919
+              dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-portbld-freebsd-ghcup-0.1.14
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2
-              dlHash: 68b09404cf49061da539463f42f8ad67c9cef5c5d3f68a3c7c4f6760e8442bb9
+              dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.14/i386-linux-ghcup-0.1.14
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2
-              dlHash: ecb1157f010d2421764c52ab0cdbbf9a5c3da555827172c7b904d5f3f96c80fa
+              dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38
           Linux_Alpine:
             unknown_versioning: *ghcup-32

ghcup-0.0.3.yaml

@@ -1451,7 +1451,7 @@ ghcupDownloads:
               dlUri: https://oleg.fi/cabal-install-3.4.0.0-rc4/cabal-install-3.4.0.0-x86_64-freebsd-12.1-release.tar.xz
               dlHash: 9705e16d03497b46be4ad477e6c64d10890af853eafa8a9adf6dba89aa9e05f7
   GHCup:
-    0.1.14:
+    0.1.16.2:
       viTags:
       - Recommended
       - Latest
@@ -1461,23 +1461,23 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-linux-ghcup-0.1.14
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2
-              dlHash: e9b314d248f4d4604ce64cee1be7161c77c8940efd11986c9205779ec3b598dd
+              dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-apple-darwin-ghcup-0.1.14
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2
-              dlHash: 69ede9db36c0ae631b679fceb87dd856d4753ee26f33610da37dd7a694809919
+              dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.14/x86_64-portbld-freebsd-ghcup-0.1.14
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2
-              dlHash: 68b09404cf49061da539463f42f8ad67c9cef5c5d3f68a3c7c4f6760e8442bb9
+              dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.14/i386-linux-ghcup-0.1.14
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2
-              dlHash: ecb1157f010d2421764c52ab0cdbbf9a5c3da555827172c7b904d5f3f96c80fa
+              dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38
           Linux_Alpine:
             unknown_versioning: *ghcup-32
   HLS:

ghcup-0.0.4.yaml

@@ -1868,7 +1868,7 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
               dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
   GHCup:
-    0.1.15.2:
+    0.1.16.2:
       viTags:
       - Recommended
       - Latest
@@ -1878,39 +1878,39 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-linux-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2
-              dlHash: 1eb1bb318a327754f42eaa2245bc81fe53be7c791160d28a186893ded3004ed7
+              dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-apple-darwin-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2
-              dlHash: c2a6436a49f19f108493954d4a3efcb27503e343dd6288c2641784d32320b1ea
+              dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-portbld-freebsd-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2
-              dlHash: 7e0c17dd78ebd9fd03e6ecea278c192bac31ca333721bde5b0ef99438b847a20
+              dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/i386-linux-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2
-              dlHash: 3b1fe710cded0398e920ec9716089ba65226abf181741897f387e7c539a619c2
+              dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38
           Linux_Alpine:
             unknown_versioning: *ghcup-32
         A_ARM64:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-linux-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-linux-ghcup-0.1.16.2
-              dlHash: d91b7a5416f292f2cf813824eb419f76ad9976d258cee3581123cb6eb01db9a7
+              dlHash: 0bdbfc724e0ddabb266156eea83c2c4e19c6ed79dd06db0c29b7d69df8d9fa8c
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-apple-darwin-ghcup-0.1.16.2
-              dlHash: 20625ba5e7488f2a6155331750ecead3815ea16b2695c20521633c1412f012cc
+              dlHash: 8854e991a2ba1350abda59dab96ce50ae7729d1ce99399d67929ef31e90f1da5
         A_ARM:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/armv7-linux-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/armv7-linux-ghcup-0.1.16.2
-              dlHash: 03a4af5ed895ada1dd21f4cc3f64dc9078a5bf4268313021d004c04bea7f9c2e
+              dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57
   HLS:
     1.1.0:
       viTags:

ghcup-0.0.5.yaml

@@ -96,6 +96,7 @@ toolRequirements:
       Linux_Alpine:
         unknown_versioning:
           distroPKGs:
+          - binutils-gold
           - curl
           - gcc
           - g++
@@ -2024,7 +2025,7 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/3.4.0.0/cabal-install-3.4.0.0-armv7-linux-bootstrapped.tar.xz
               dlHash: 16c0d1eaba24bed14f3e152970179a45d9f9bb5cc839b2c210ad06eb7d4826ed
   GHCup:
-    0.1.15.2:
+    0.1.16.2:
       viTags:
       - Recommended
       - Latest
@@ -2034,52 +2035,55 @@ ghcupDownloads:
         A_64:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-64
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-linux-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-linux-ghcup-0.1.16.2
-              dlHash: 1eb1bb318a327754f42eaa2245bc81fe53be7c791160d28a186893ded3004ed7
+              dlHash: d5e43b95ce1d42263376e414f7eb7c5dd440271c7c6cd9bad446fdeff3823893
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-apple-darwin-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-apple-darwin-ghcup-0.1.16.2
-              dlHash: c2a6436a49f19f108493954d4a3efcb27503e343dd6288c2641784d32320b1ea
+              dlHash: a334620ccce7705211b2142882dde544003e6030af4b91a44c890542a90f879f
           FreeBSD:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-portbld-freebsd-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-portbld-freebsd-ghcup-0.1.16.2
-              dlHash: 7e0c17dd78ebd9fd03e6ecea278c192bac31ca333721bde5b0ef99438b847a20
+              dlHash: 92359592a5694375e53b22628920086bf4bbf0faff5be018a0ed3e745a6426a9
           Windows:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/x86_64-mingw64-ghcup-0.1.15.2.exe
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/x86_64-mingw64-ghcup-0.1.16.2.exe
-              dlHash: 4d832052754379531ac472aeef35666e433acfee79d4079826b8ede8ca5de520
+              dlHash: ec78872a84213968c490675127b9aad2285980b747c68207801ae824b98c7948
           Linux_Alpine:
             unknown_versioning: *ghcup-64
         A_32:
           Linux_UnknownLinux:
             unknown_versioning: &ghcup-32
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/i386-linux-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/i386-linux-ghcup-0.1.16.2
-              dlHash: 3b1fe710cded0398e920ec9716089ba65226abf181741897f387e7c539a619c2
+              dlHash: 01968ca6decac7b6e8ba6e2c817870d3fa47289a6507e0c1ab563f7b6eec0e38
           Linux_Alpine:
             unknown_versioning: *ghcup-32
         A_ARM64:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-linux-ghcup-0.1.15.2-r1
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-linux-ghcup-0.1.16.2
-              dlHash: d853372440f3d43babbb868fad399811241760f2233829c92403fcbea8c547ec
+              dlHash: 0bdbfc724e0ddabb266156eea83c2c4e19c6ed79dd06db0c29b7d69df8d9fa8c
           Darwin:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/aarch64-apple-darwin-ghcup-0.1.15.2
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/aarch64-apple-darwin-ghcup-0.1.16.2
-              dlHash: 20625ba5e7488f2a6155331750ecead3815ea16b2695c20521633c1412f012cc
+              dlHash: 8854e991a2ba1350abda59dab96ce50ae7729d1ce99399d67929ef31e90f1da5
         A_ARM:
           Linux_UnknownLinux:
             unknown_versioning:
-              dlUri: https://downloads.haskell.org/~ghcup/0.1.15.2/armv7-linux-ghcup-0.1.15.2-r1
+              dlUri: https://downloads.haskell.org/~ghcup/0.1.16.2/armv7-linux-ghcup-0.1.16.2
-              dlHash: f8add9b39e1f7d0f03904dc69a8683259972a4472432c1ade27d918c39a4a874
+              dlHash: 983ebb5b584bfa600704216a63f94b40d36a02573834e90ef1042c8472d9ad57
   HLS:
     1.1.0:
       viTags: []
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#110
-      viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
+      viPostInstall: &hls-post-install |
+        This is just the server part of your LSP configuration. Consult the README on how to
+        configure HLS, your project and your LSP client in your editor:
+          https://github.com/haskell/haskell-language-server/blob/master/README.md
       viArch:
         A_64:
           Linux_UnknownLinux:
-            unknown_versioning: &hls-64
+            unknown_versioning: &hls-110-64
               dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.1.0/haskell-language-server-Linux-1.1.0.tar.gz
               dlHash: 0f0dadb0e9a08273658f565fd71c636801959b954be2737f38f2a1aac522208f
           Darwin:
@@ -2091,17 +2095,15 @@ ghcupDownloads:
               dlUri: https://downloads.haskell.org/ghcup/unofficial-bindists/hls/1.1.0/haskell-language-server-Windows-1.1.0.tar.gz
               dlHash: a1d3f451e64a041aa527a25da29e4716a2de6ae347cef4ef9312fc7611e168cc
           Linux_Alpine:
-            unknown_versioning: *hls-64
+            unknown_versioning: *hls-110-64
     1.2.0:
-      viTags:
+      viTags: []
-        - Recommended
-        - Latest
       viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#120
-      viPostInstall: "This is just the server part of your LSP configuration. Consult the README on how to configure HLS, your project and your LSP client in your editor: https://github.com/haskell/haskell-language-server/blob/master/README.md"
+      viPostInstall: *hls-post-install
       viArch:
         A_64:
           Linux_UnknownLinux:
-            unknown_versioning: &hls-64
+            unknown_versioning: &hls-120-64
               dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Linux-1.2.0.tar.gz
               dlHash: d29ee22f7bd706da2e2a1bd7640e25bb9736adeafb34eef47d29ea143b0fa927
           Darwin:
@@ -2113,7 +2115,29 @@ ghcupDownloads:
               dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.2.0/haskell-language-server-Windows-1.2.0.tar.gz
               dlHash: 961c6ff12c9a9c7a4609f239c5ac70d7d16753cdb8c10348a6a51feeaa0b6aea
           Linux_Alpine:
-            unknown_versioning: *hls-64
+            unknown_versioning: *hls-120-64
+    1.3.0:
+      viTags:
+        - Recommended
+        - Latest
+      viChangeLog: https://github.com/haskell/haskell-language-server/blob/master/ChangeLog.md#130
+      viPostInstall: *hls-post-install
+      viArch:
+        A_64:
+          Linux_UnknownLinux:
+            unknown_versioning: &hls-130-64
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.3.0/haskell-language-server-Linux-1.3.0.tar.gz
+              dlHash: d29ee22f7bd706da2e2a1bd7640e25bb9736adeafb34eef47d29ea143b0fa927
+          Darwin:
+            unknown_versioning:
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.3.0/haskell-language-server-macOS-1.3.0.tar.gz
+              dlHash: a310d8a3e9c5c4218210f750682c74a0f82ad0f59995adde0dbe775115b1e357
+          Windows:
+            unknown_versioning:
+              dlUri: https://github.com/haskell/haskell-language-server/releases/download/1.3.0/haskell-language-server-Windows-1.3.0.tar.gz
+              dlHash: 961c6ff12c9a9c7a4609f239c5ac70d7d16753cdb8c10348a6a51feeaa0b6aea
+          Linux_Alpine:
+            unknown_versioning: *hls-130-64
   Stack:
     2.5.1:
       viTags:

ghcup.cabal

@@ -1,6 +1,6 @@
 cabal-version:   3.0
 name:            ghcup
-version:         0.1.15.2
+version:         0.1.16.2
 license:         LGPL-3.0-only
 license-file:    LICENSE
 copyright:       Julian Ospald 2020
@@ -20,6 +20,8 @@ extra-doc-files:
   config.yaml
   ghcup-0.0.4.yaml
   ghcup-0.0.5.yaml
+  ghcup-0.0.6.yaml
+  ghcup-0.0.7.yaml
   HACKING.md
   README.md
   RELEASING.md
@@ -42,11 +44,6 @@ flag internal-downloader
   default:     False
   manual:      True
 
-flag tar
-  description: Use tar-bytestring instead of libarchive.
-  default:     False
-  manual:      True
-
 library
   exposed-modules:
     GHCup
@@ -109,17 +106,15 @@ library
     , disk-free-space       ^>=0.1.0.1
     , extra                 ^>=1.7.9
     , filepath              ^>=1.4.2.1
-    , generics-sop          ^>=0.5
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  >=3.0        && <3.2
+    , libarchive            ^>=3.0.0.0
     , lzma-static           ^>=5.2.5.3
     , megaparsec            >=8.0.0      && <9.1
     , monad-logger          ^>=0.3.31
     , mtl                   ^>=2.2
     , optics                ^>=0.4
-    , optics-vl             ^>=0.2
     , os-release            ^>=1.0.0
-    , parsec                ^>=3.1
     , pretty                ^>=1.1.3.1
     , pretty-terminal       ^>=0.1.0.0
     , regex-posix           ^>=0.96
@@ -128,7 +123,6 @@ library
     , safe-exceptions       ^>=0.1
     , split                 ^>=0.2.3.4
     , strict-base           ^>=0.4
-    , string-interpolate    >=0.2.0.0    && <0.4
     , template-haskell      >=2.7        && <2.18
     , temporary             ^>=1.3
     , text                  ^>=1.2.4.0
@@ -137,7 +131,6 @@ library
     , unliftio-core         ^>=0.2.0.1
     , unordered-containers  ^>=0.2.10.0
     , uri-bytestring        ^>=0.3.2.2
-    , utf8-string           ^>=1.0
     , vector                ^>=0.12
     , versions              >=4.0.1      && <5.1
     , word8                 ^>=0.1.3
@@ -154,13 +147,6 @@ library
       , io-streams             >=1.5.2.1
       , terminal-progress-bar  >=0.4.1
 
-  if flag(tar)
-    cpp-options:   -DTAR
-    build-depends: tar
-
-  else
-    build-depends: libarchive ^>=3.0.0.0
-
   if os(windows)
     cpp-options:   -DIS_WINDOWS
     other-modules: GHCup.Utils.File.Windows
@@ -174,8 +160,6 @@ library
     other-modules: GHCup.Utils.File.Posix
     build-depends:
       , bz2              >=0.5.0.5 && <1.1
-      , hpath-posix      ^>=0.13.3
-      , process          ^>=1.6.9
       , unix             ^>=2.7
       , unix-bytestring  ^>=0.3.7.3
 
@@ -210,6 +194,7 @@ executable ghcup
     , filepath              ^>=1.4.2.1
     , ghcup
     , haskus-utils-variant  >=3.0      && <3.2
+    , libarchive            ^>=3.0.0.0
     , megaparsec            >=8.0.0    && <9.1
     , monad-logger          ^>=0.3.31
     , mtl                   ^>=2.2
@@ -219,12 +204,12 @@ executable ghcup
     , resourcet             ^>=1.2.2
     , safe                  ^>=0.3.18
     , safe-exceptions       ^>=0.1
-    , string-interpolate    >=0.2.0.0  && <0.4
     , template-haskell      >=2.7      && <2.18
     , text                  ^>=1.2.4.0
     , uri-bytestring        ^>=0.3.2.2
     , utf8-string           ^>=1.0
     , versions              >=4.0.1    && <5.1
+    , yaml                  ^>=0.11.4.0
 
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
@@ -233,7 +218,7 @@ executable ghcup
     cpp-options:   -DBRICK
     other-modules: BrickMain
     build-depends:
-      , brick         >=0.5    && <0.64
+      , brick         ^>=0.64
       , transformers  ^>=0.5
       , vector        ^>=0.12
       , vty           >=5.28.2 && <5.34
@@ -241,12 +226,6 @@ executable ghcup
   if os(windows)
     cpp-options: -DIS_WINDOWS
 
-  if flag(tar)
-    cpp-options: -DTAR
-
-  else
-    build-depends: libarchive ^>=3.0.0.0
-
 executable ghcup-gen
   main-is:            Main.hs
   hs-source-dirs:     app/ghcup-gen
@@ -278,6 +257,7 @@ executable ghcup-gen
     , filepath              ^>=1.4.2.1
     , ghcup
     , haskus-utils-variant  >=3.0      && <3.2
+    , libarchive            ^>=3.0.0.0
     , monad-logger          ^>=0.3.31
     , mtl                   ^>=2.2
     , optics                ^>=0.4
@@ -287,20 +267,11 @@ executable ghcup-gen
     , regex-posix           ^>=0.96
     , resourcet             ^>=1.2.2
     , safe-exceptions       ^>=0.1
-    , string-interpolate    >=0.2.0.0  && <0.4
     , text                  ^>=1.2.4.0
     , transformers          ^>=0.5
-    , uri-bytestring        ^>=0.3.2.2
     , versions              >=4.0.1    && <5.1
     , yaml                  ^>=0.11.4.0
 
-  if flag(tar)
-    cpp-options:   -DTAR
-    build-depends: tar
-
-  else
-    build-depends: libarchive ^>=3.0.0.0
-
 test-suite ghcup-test
   type:               exitcode-stdio-1.0
   main-is:            Main.hs

lib/GHCup.hs

@@ -39,9 +39,7 @@ import           GHCup.Utils.String.QQ
 import           GHCup.Utils.Version.QQ
 import           GHCup.Version
 
-#if !defined(TAR)
 import           Codec.Archive                  ( ArchiveResult )
-#endif
 import           Control.Applicative
 import           Control.DeepSeq                ( force )
 import           Control.Exception              ( evaluate )
@@ -63,7 +61,6 @@ import           Data.List
 import           Data.List.Extra
 import           Data.Maybe
 import           Data.String                    ( fromString )
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Time.Clock
 import           Data.Time.Format.ISO8601
@@ -92,6 +89,7 @@ import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as BL
 import qualified Data.Map.Strict               as Map
 import qualified Data.Text                     as T
+import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
 #if defined(IS_WINDOWS)
 import qualified System.Win32.File             as Win32
@@ -186,6 +184,7 @@ installGHCBindist :: ( MonadFail m
                      )
                   => DownloadInfo    -- ^ where/how to download
                   -> Version         -- ^ the version to install
+                  -> Maybe FilePath  -- ^ isolated filepath if user passed any
                   -> Excepts
                        '[ AlreadyInstalled
                         , BuildFailed
@@ -195,16 +194,20 @@ installGHCBindist :: ( MonadFail m
                         , NotInstalled
                         , UnknownArchive
                         , TarDirDoesNotExist
-#if !defined(TAR)
+                        , DirNotEmpty
                         , ArchiveResult
-#endif
                         ]
                        m
                        ()
-installGHCBindist dlinfo ver = do
+installGHCBindist dlinfo ver isoFilepath = do
   let tver = mkTVer ver
-  lift $ $(logDebug) [i|Requested to install GHC with #{ver}|]
+
-  whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
+  lift $ $(logDebug) $ "Requested to install GHC with " <> prettyVer ver
+
+  case isoFilepath of
+    -- we only care for already installed errors in regular (non-isolated) installs
+    Nothing -> whenM (lift $ ghcInstalled tver) (throwE $ AlreadyInstalled GHC ver)
+    _ -> pure ()
 
   -- download (or use cached version)
   dl <- liftE $ downloadCached dlinfo Nothing
@@ -214,8 +217,14 @@ installGHCBindist dlinfo ver = do
 
   toolchainSanityChecks
   
+  case isoFilepath of
+    Just isoDir -> do                        -- isolated install
+      lift $ $(logInfo) $ "isolated installing GHC to " <> T.pack isoDir
+      liftE $ installPackedGHC dl (view dlSubdir dlinfo) isoDir ver
+    Nothing -> do                            -- regular install
       liftE $ installPackedGHC dl (view dlSubdir dlinfo) ghcdir ver
 
+      -- make symlinks & stuff when regular install,
       liftE $ postGHCInstall tver
 
  where
@@ -250,17 +259,18 @@ installPackedGHC :: ( MonadMask m
                       '[ BuildFailed
                        , UnknownArchive
                        , TarDirDoesNotExist
-#if !defined(TAR)
+                       , DirNotEmpty
                        , ArchiveResult
-#endif
                        ] m ()
 installPackedGHC dl msubdir inst ver = do
   PlatformRequest {..} <- lift getPlatformReq
 
+  liftE $ installDestSanityCheck inst
+
   -- unpack
   tmpUnpack <- lift mkGhcupTmpDir
   liftE $ unpackToDir tmpUnpack dl
-  void $ lift $ darwinNotarization _rPlatform tmpUnpack
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack)
@@ -270,6 +280,22 @@ installPackedGHC dl msubdir inst ver = do
   liftE $ runBuildAction tmpUnpack
                          (Just inst)
                          (installUnpackedGHC workdir inst ver)
+ where
+  -- | Does basic checks for isolated installs
+  -- Isolated Directory:
+  --   1. if it doesn't exist -> proceed
+  --   2. if it exists and is empty -> proceed
+  --   3. if it exists and is non-empty -> panic and leave the house
+  installDestSanityCheck :: ( MonadIO m
+                            , MonadCatch m
+                            ) =>
+                            FilePath ->
+                            Excepts '[DirNotEmpty] m ()
+  installDestSanityCheck isoDir = do
+    hideErrorDef [doesNotExistErrorType] () $ do
+      contents <- liftIO $ getDirectoryContentsRecursive isoDir
+      unless (null contents) (throwE $ DirNotEmpty isoDir)
+
 
 
 -- | Install an unpacked GHC distribution. This only deals with the GHC
@@ -300,10 +326,6 @@ installUnpackedGHC path inst ver = do
     setModificationTime dest mtime
 #else
   PlatformRequest {..} <- lift getPlatformReq
-  liftIO $ copyDirectoryRecursive path inst $ \source dest -> do
-    mtime <- getModificationTime source
-    copyFile source dest
-    setModificationTime dest mtime
 
   let alpineArgs
        | ver >= [vver|8.2.2|], Linux Alpine <- _rPlatform
@@ -343,6 +365,7 @@ installGHCBin :: ( MonadFail m
                  , MonadUnliftIO m
                  )
               => Version         -- ^ the version to install
+              -> Maybe FilePath  -- ^ isolated install filepath, if user passed any
               -> Excepts
                    '[ AlreadyInstalled
                     , BuildFailed
@@ -352,15 +375,14 @@ installGHCBin :: ( MonadFail m
                     , NotInstalled
                     , UnknownArchive
                     , TarDirDoesNotExist
-#if !defined(TAR)
+                    , DirNotEmpty
                     , ArchiveResult
-#endif
                     ]
                    m
                    ()
-installGHCBin ver = do
+installGHCBin ver isoFilepath = do
   dlinfo <- liftE $ getDownloadInfo GHC ver
-  installGHCBindist dlinfo ver
+  installGHCBindist dlinfo ver isoFilepath
 
 
 -- | Like 'installCabalBin', except takes the 'DownloadInfo' as
@@ -379,6 +401,7 @@ installCabalBindist :: ( MonadMask m
                        )
                     => DownloadInfo
                     -> Version
+                    -> Maybe FilePath -- ^ isolated install filepath, if user provides any.
                     -> Excepts
                          '[ AlreadyInstalled
                           , CopyError
@@ -388,18 +411,19 @@ installCabalBindist :: ( MonadMask m
                           , NotInstalled
                           , UnknownArchive
                           , TarDirDoesNotExist
-#if !defined(TAR)
                           , ArchiveResult
-#endif
+                          , FileAlreadyExistsError
                           ]
                          m
                          ()
-installCabalBindist dlinfo ver = do
+installCabalBindist dlinfo ver isoFilepath = do
-  lift $ $(logDebug) [i|Requested to install cabal version #{ver}|]
+  lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
 
+  case isoFilepath of
+    Nothing -> -- for regular install check if any previous versions installed
       whenM
         (lift (cabalInstalled ver) >>= \a -> liftIO $
           handleIO (\_ -> pure False)
@@ -409,42 +433,51 @@ installCabalBindist dlinfo ver = do
         )
         (throwE $ AlreadyInstalled Cabal ver)
 
+    _ -> pure () -- check isn't required in isolated installs
+
   -- download (or use cached version)
   dl <- liftE $ downloadCached dlinfo Nothing
 
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
   liftE $ unpackToDir tmpUnpack dl
-  void $ lift $ darwinNotarization _rPlatform tmpUnpack
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
 
-  liftE $ installCabal' workdir binDir
+  case isoFilepath of
+    Just isoDir -> do             -- isolated install
+      lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir
+      liftE $ installCabalUnpacked workdir isoDir Nothing
 
-  -- create symlink if this is the latest version
+    Nothing -> do                 -- regular install
+      liftE $ installCabalUnpacked workdir binDir (Just ver)
+
+      -- create symlink if this is the latest version for regular installs
       cVers <- lift $ fmap rights getInstalledCabals
       let lInstCabal = headMay . reverse . sort $ cVers
       when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver
 
- where
 -- | Install an unpacked cabal distribution.
-  installCabal' :: (MonadLogger m, MonadCatch m, MonadIO m)
+installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked cabal bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
-                -> Excepts '[CopyError] m ()
+              -> Maybe Version -- ^ Nothing for isolated install
-  installCabal' path inst = do
+              -> Excepts '[CopyError, FileAlreadyExistsError] m ()
+installCabalUnpacked path inst mver' = do
   lift $ $(logInfo) "Installing cabal"
   let cabalFile = "cabal"
   liftIO $ createDirRecursive' inst
-    let destFileName = cabalFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
+  let destFileName = cabalFile
+        <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
+        <> exeExt
   let destPath = inst </> destFileName
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> cabalFile <> exeExt)
     destPath
   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.
@@ -462,6 +495,7 @@ installCabalBin :: ( MonadMask m
                    , MonadFail m
                    )
                 => Version
+                -> Maybe FilePath -- isolated install Path, if user provided any
                 -> Excepts
                      '[ AlreadyInstalled
                       , CopyError
@@ -471,15 +505,14 @@ installCabalBin :: ( MonadMask m
                       , NotInstalled
                       , UnknownArchive
                       , TarDirDoesNotExist
-#if !defined(TAR)
                       , ArchiveResult
-#endif
+                      , FileAlreadyExistsError
                       ]
                      m
                      ()
-installCabalBin ver = do
+installCabalBin ver isoFilepath = do
   dlinfo <- liftE $ getDownloadInfo Cabal ver
-  installCabalBindist dlinfo ver
+  installCabalBindist dlinfo ver isoFilepath
 
 
 -- | Like 'installHLSBin, except takes the 'DownloadInfo' as
@@ -498,6 +531,7 @@ installHLSBindist :: ( MonadMask m
                      )
                   => DownloadInfo
                   -> Version
+                  -> Maybe FilePath -- ^ isolated install path, if user passed any
                   -> Excepts
                        '[ AlreadyInstalled
                         , CopyError
@@ -507,46 +541,56 @@ installHLSBindist :: ( MonadMask m
                         , NotInstalled
                         , UnknownArchive
                         , TarDirDoesNotExist
-#if !defined(TAR)
                         , ArchiveResult
-#endif
                         ]
                        m
                        ()
-installHLSBindist dlinfo ver = do
+installHLSBindist dlinfo ver isoFilepath = do
-  lift $ $(logDebug) [i|Requested to install hls version #{ver}|]
+  lift $ $(logDebug) $ "Requested to install hls version " <> prettyVer ver
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
 
+  case isoFilepath of
+    Nothing ->
+      -- we only check for already installed in regular (non-isolated) installs
       whenM (lift (hlsInstalled ver))
       (throwE $ AlreadyInstalled HLS ver)
 
+    _ -> pure ()
+
   -- download (or use cached version)
   dl <- liftE $ downloadCached dlinfo Nothing
 
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
   liftE $ unpackToDir tmpUnpack dl
-  void $ lift $ darwinNotarization _rPlatform tmpUnpack
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
 
-  liftE $ installHLS' workdir binDir
+  case isoFilepath of
+    Just isoDir -> do
+      lift $ $(logInfo) $ "isolated installing HLS to " <> T.pack isoDir
+      liftE $ installHLSUnpacked workdir isoDir Nothing
 
-  -- create symlink if this is the latest version
+    Nothing -> do
+      liftE $ installHLSUnpacked workdir binDir (Just ver)
+
+      -- create symlink if this is the latest version in a regular install
       hlsVers <- lift $ fmap rights getInstalledHLSs
       let lInstHLS = headMay . reverse . sort $ hlsVers
       when (maybe True (ver >=) lInstHLS) $ liftE $ setHLS ver
 
- where
+
 -- | Install an unpacked hls distribution.
-  installHLS' :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
+installHLSUnpacked :: (MonadFail m, MonadLogger m, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked hls bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
+              -> Maybe Version -- ^ Nothing for isolated install
               -> Excepts '[CopyError] m ()
-  installHLS' path inst = do
+installHLSUnpacked path inst mver' = do
   lift $ $(logInfo) "Installing HLS"
   liftIO $ createDirRecursive' inst
 
@@ -559,7 +603,8 @@ installHLSBindist dlinfo ver = do
     )
   forM_ bins $ \f -> do
     let toF = dropSuffix exeExt f
-                <> "~" <> T.unpack (prettyVer ver) <> exeExt
+              <> maybe "" (("~" <>) . T.unpack . prettyVer) mver'
+              <> exeExt
     handleIO (throwE . CopyError . show) $ liftIO $ copyFile
       (path </> f)
       (inst </> toF)
@@ -567,13 +612,14 @@ installHLSBindist dlinfo ver = do
 
   -- install haskell-language-server-wrapper
   let wrapper = "haskell-language-server-wrapper"
-        toF = wrapper <> "-" <> T.unpack (prettyVer ver) <> exeExt
+      toF = wrapper
+            <> maybe "" (("-" <>) . T.unpack . prettyVer) mver'
+            <> exeExt
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> wrapper <> exeExt)
     (inst </> toF)
   lift $ chmod_755 (inst </> toF)
 
-
 -- | Installs hls binaries @haskell-language-server-\<ghcver\>@
 -- into @~\/.ghcup\/bin/@, as well as @haskell-languager-server-wrapper@.
 installHLSBin :: ( MonadMask m
@@ -590,6 +636,7 @@ installHLSBin :: ( MonadMask m
                  , MonadFail m
                  )
               => Version
+              -> Maybe FilePath
               -> Excepts
                    '[ AlreadyInstalled
                     , CopyError
@@ -599,15 +646,13 @@ installHLSBin :: ( MonadMask m
                     , NotInstalled
                     , UnknownArchive
                     , TarDirDoesNotExist
-#if !defined(TAR)
                     , ArchiveResult
-#endif
                     ]
                    m
                    ()
-installHLSBin ver = do
+installHLSBin ver isoFilepath = do
   dlinfo <- liftE $ getDownloadInfo HLS ver
-  installHLSBindist dlinfo ver
+  installHLSBindist dlinfo ver isoFilepath
 
 
 -- | Installs stack into @~\/.ghcup\/bin/stack-\<ver\>@ and
@@ -627,6 +672,7 @@ installStackBin :: ( MonadMask m
                    , MonadFail m
                    )
                 => Version
+                -> Maybe FilePath
                 -> Excepts
                      '[ AlreadyInstalled
                       , CopyError
@@ -636,15 +682,13 @@ installStackBin :: ( MonadMask m
                       , NotInstalled
                       , UnknownArchive
                       , TarDirDoesNotExist
-#if !defined(TAR)
                       , ArchiveResult
-#endif
                       ]
                      m
                      ()
-installStackBin ver = do
+installStackBin ver isoFilepath = do
   dlinfo <- liftE $ getDownloadInfo Stack ver
-  installStackBindist dlinfo ver
+  installStackBindist dlinfo ver isoFilepath
 
 
 -- | Like 'installStackBin', except takes the 'DownloadInfo' as
@@ -663,6 +707,7 @@ installStackBindist :: ( MonadMask m
                        )
                     => DownloadInfo
                     -> Version
+                    -> Maybe FilePath
                     -> Excepts
                          '[ AlreadyInstalled
                           , CopyError
@@ -672,50 +717,60 @@ installStackBindist :: ( MonadMask m
                           , NotInstalled
                           , UnknownArchive
                           , TarDirDoesNotExist
-#if !defined(TAR)
                           , ArchiveResult
-#endif
                           ]
                          m
                          ()
-installStackBindist dlinfo ver = do
+installStackBindist dlinfo ver isoFilepath = do
-  lift $ $(logDebug) [i|Requested to install stack version #{ver}|]
+  lift $ $(logDebug) $ "Requested to install stack version " <> prettyVer ver
 
   PlatformRequest {..} <- lift getPlatformReq
   Dirs {..} <- lift getDirs
 
+  case isoFilepath of
+    Nothing ->             -- check previous versions in case of regular installs
       whenM (lift (stackInstalled ver))
       (throwE $ AlreadyInstalled Stack ver)
 
+    _ -> pure ()           -- don't do shit for isolates
+
   -- download (or use cached version)
   dl <- liftE $ downloadCached dlinfo Nothing
 
   -- unpack
   tmpUnpack <- lift withGHCupTmpDir
   liftE $ unpackToDir tmpUnpack dl
-  void $ lift $ darwinNotarization _rPlatform tmpUnpack
+  liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
   -- the subdir of the archive where we do the work
   workdir <- maybe (pure tmpUnpack) (liftE . intoSubdir tmpUnpack) (view dlSubdir dlinfo)
 
-  liftE $ installStack' workdir binDir
+  case isoFilepath of
+    Just isoDir -> do                 -- isolated install
+      lift $ $(logInfo) $ "isolated installing Stack to " <> T.pack isoDir
+      liftE $ installStackUnpacked workdir isoDir Nothing
+    Nothing -> do                     -- regular install
+      liftE $ installStackUnpacked workdir binDir (Just ver)
 
-  -- create symlink if this is the latest version
+      -- create symlink if this is the latest version and a regular install
       sVers <- lift $ fmap rights getInstalledStacks
       let lInstStack = headMay . reverse . sort $ sVers
       when (maybe True (ver >=) lInstStack) $ liftE $ setStack ver
 
- where
+
 -- | Install an unpacked stack distribution.
-  installStack' :: (MonadLogger m, MonadCatch m, MonadIO m)
+installStackUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
               => FilePath      -- ^ Path to the unpacked stack bindist (where the executable resides)
               -> FilePath      -- ^ Path to install to
+              -> Maybe Version -- ^ Nothing for isolated installs
               -> Excepts '[CopyError] m ()
-  installStack' path inst = do
+installStackUnpacked path inst mver' = do
   lift $ $(logInfo) "Installing stack"
   let stackFile = "stack"
   liftIO $ createDirRecursive' inst
-    let destFileName = stackFile <> "-" <> T.unpack (prettyVer ver) <> exeExt
+  let destFileName = stackFile
+                     <> maybe "" (("-" <>) .  T.unpack . prettyVer) mver'
+                     <> exeExt
   let destPath = inst </> destFileName
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile
     (path </> stackFile <> exeExt)
@@ -723,8 +778,6 @@ installStackBindist dlinfo ver = do
   lift $ chmod_755 destPath
 
 
-
-
     ---------------------
     --[ Set GHC/cabal ]--
     ---------------------
@@ -776,7 +829,7 @@ setGHC ver sghc = do
       SetGHCOnly -> pure $ Just file
       SetGHC_XY  -> do
         handle
-            (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
+            (\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
           $ do 
             (mj, mi) <- getMajorMinorV (_tvVersion ver)
             let major' = intToText mj <> "." <> intToText mi
@@ -818,9 +871,9 @@ setGHC ver sghc = do
         whenM (liftIO $ doesDirectoryExist fullsharedir) $ do
           let fullF   = destdir </> sharedir
           let targetF = "." </> "ghc" </> ver' </> sharedir
-          $(logDebug) [i|rm -f #{fullF}|]
+          $(logDebug) $ "rm -f " <> T.pack fullF
           hideError doesNotExistErrorType $ rmDirectoryLink fullF
-          $(logDebug) [i|ln -s #{targetF} #{fullF}|]
+          $(logDebug) $ "ln -s " <> T.pack targetF <> " " <> T.pack fullF
           liftIO
 #if defined(IS_WINDOWS)
             -- On windows we need to be more permissive
@@ -886,7 +939,7 @@ setHLS ver = do
   -- selected version, so we could end up with stray or incorrect symlinks.
   oldSyms <- lift hlsSymlinks
   forM_ oldSyms $ \f -> do
-    lift $ $(logDebug) [i|rm #{binDir </> f}|]
+    lift $ $(logDebug) $ "rm " <> T.pack (binDir </> f)
     lift $ rmLink (binDir </> f)
 
   -- set haskell-language-server-<ghcver> symlinks
@@ -965,9 +1018,9 @@ data ListResult = ListResult
 
 
 -- | Extract all available tool versions and their tags.
-availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version [Tag]
+availableToolVersions :: GHCupDownloads -> Tool -> Map.Map Version VersionInfo
 availableToolVersions av tool = view
-  (at tool % non Map.empty % to (fmap _viTags))
+  (at tool % non Map.empty)
   av
 
 
@@ -1018,7 +1071,9 @@ listVersions lt' criteria = do
           Stack -> do
             slr <- strayStacks avTools sSet stacks
             pure (sort (slr ++ lr))
-          GHCup -> pure 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
@@ -1033,7 +1088,7 @@ listVersions lt' criteria = do
                , MonadLogger m
                , MonadIO m
                )
-            => Map.Map Version [Tag]
+            => Map.Map Version VersionInfo
             -> m [ListResult]
   strayGHCs avTools = do
     ghcs <- getInstalledGHCs
@@ -1071,7 +1126,7 @@ listVersions lt' criteria = do
           }
       Left e -> do
         $(logWarn)
-          [i|Could not parse version of stray directory #{e}|]
+          $ "Could not parse version of stray directory" <> T.pack e
         pure Nothing
 
   strayCabals :: ( MonadReader env m
@@ -1081,7 +1136,7 @@ listVersions lt' criteria = do
                  , MonadLogger m
                  , MonadIO m
                  )
-            => Map.Map Version [Tag]
+            => Map.Map Version VersionInfo
             -> Maybe Version
             -> [Either FilePath Version]
             -> m [ListResult]
@@ -1106,7 +1161,7 @@ listVersions lt' criteria = do
               }
       Left e -> do
         $(logWarn)
-          [i|Could not parse version of stray directory #{e}|]
+          $ "Could not parse version of stray directory" <> T.pack e
         pure Nothing
 
   strayHLS :: ( MonadReader env m
@@ -1115,7 +1170,7 @@ listVersions lt' criteria = do
               , MonadThrow m
               , MonadLogger m
               , MonadIO m)
-           => Map.Map Version [Tag]
+           => Map.Map Version VersionInfo
            -> Maybe Version
            -> [Either FilePath Version]
            -> m [ListResult]
@@ -1140,7 +1195,7 @@ listVersions lt' criteria = do
               }
       Left e -> do
         $(logWarn)
-          [i|Could not parse version of stray directory #{e}|]
+          $ "Could not parse version of stray directory" <> T.pack e
         pure Nothing
 
   strayStacks :: ( MonadReader env m
@@ -1150,7 +1205,7 @@ listVersions lt' criteria = do
                  , MonadLogger m
                  , MonadIO m
                  )
-              => Map.Map Version [Tag]
+              => Map.Map Version VersionInfo
               -> Maybe Version
               -> [Either FilePath Version]
               -> m [ListResult]
@@ -1175,9 +1230,29 @@ listVersions lt' criteria = do
               }
       Left e -> do
         $(logWarn)
-          [i|Could not parse version of stray directory #{e}|]
+          $ "Could not parse version of stray directory" <> T.pack e
         pure Nothing
 
+  currentGHCup :: Map.Map Version VersionInfo -> Maybe ListResult
+  currentGHCup av =
+    let currentVer = 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 :: ( MonadLogger m
                   , MonadReader env m
@@ -1194,9 +1269,9 @@ listVersions lt' criteria = do
                -> [Either FilePath Version]
                -> Maybe Version
                -> [Either FilePath Version]
-               -> (Version, [Tag])
+               -> (Version, VersionInfo)
                -> m ListResult
-  toListResult t cSet cabals hlsSet' hlses stackSet' stacks (v, tags) = do
+  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
@@ -1298,23 +1373,23 @@ rmGHCVer ver = do
 
   -- this isn't atomic, order matters
   when isSetGHC $ do
-    lift $ $(logInfo) [i|Removing ghc symlinks|]
+    lift $ $(logInfo) "Removing ghc symlinks"
     liftE $ rmPlain (_tvTarget ver)
 
-  lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
+  lift $ $(logInfo) "Removing ghc-x.y.z symlinks"
   liftE $ rmMinorSymlinks ver
 
-  lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
+  lift $ $(logInfo) "Removing/rewiring ghc-x.y symlinks"
   -- first remove
   handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver
   -- then fix them (e.g. with an earlier version)
 
-  lift $ $(logInfo) [i|Removing directory recursively: #{dir}|]
+  lift $ $(logInfo) $ "Removing directory recursively: " <> T.pack dir
   lift $ recyclePathForcibly dir
 
   v' <-
     handle
-      (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
+      (\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
     $ fmap Just
     $ getMajorMinorV (_tvVersion ver)
   forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
@@ -1385,7 +1460,7 @@ rmHLSVer ver = do
     oldSyms <- lift hlsSymlinks
     forM_ oldSyms $ \f -> do
       let fullF = binDir </> f
-      lift $ $(logDebug) [i|rm #{fullF}|]
+      lift $ $(logDebug) $ "rm " <> T.pack fullF
       lift $ rmLink fullF
     -- set latest hls
     hlsVers <- lift $ fmap rights getInstalledHLSs
@@ -1520,12 +1595,15 @@ rmGhcupDirs = do
 
   handleRm $ rmEnvFile  envFilePath
   handleRm $ rmConfFile confFilePath
-  handleRm $ rmDir cacheDir
+  
+  -- for xdg dirs, the order matters here
   handleRm $ rmDir logsDir
+  handleRm $ rmDir cacheDir
+
   handleRm $ rmBinDir binDir
   handleRm $ rmDir recycleDir
 #if defined(IS_WINDOWS)
-  $logInfo [i|removing #{(baseDir </> "msys64")}|]
+  $logInfo $ "removing " <> T.pack (baseDir </> "msys64")
   handleRm $ rmPathForcibly (baseDir </> "msys64")
 #endif
 
@@ -1537,18 +1615,18 @@ rmGhcupDirs = do
 
   where
     handleRm :: (MonadCatch m, MonadLogger m)  => m () -> m ()
-    handleRm = handleIO (\e -> $logWarn [i|Part of the cleanup action failed with error: #{displayException e}
+    handleRm = handleIO (\e -> $logDebug $ "Part of the cleanup action failed with error: " <> T.pack (displayException e) <> "\n"
-continuing regardless...|])
+                                <> "continuing regardless...")
 
     rmEnvFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
     rmEnvFile enFilePath = do
       $logInfo "Removing Ghcup Environment File"
-      deleteFile enFilePath
+      hideErrorDef [permissionErrorType] () $ deleteFile enFilePath
 
     rmConfFile :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
     rmConfFile confFilePath = do
       $logInfo "removing Ghcup Config File"
-      deleteFile confFilePath
+      hideErrorDef [permissionErrorType] () $ deleteFile confFilePath
 
     rmDir :: (MonadLogger m, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
     rmDir dir =
@@ -1556,7 +1634,7 @@ continuing regardless...|])
       -- an error leaks through, we catch it here as well,
       -- althought 'deleteFile' should already handle it.
       hideErrorDef [doesNotExistErrorType] () $ do
-        $logInfo [i|removing #{dir}|]
+        $logInfo $ "removing " <> T.pack dir
         contents <- liftIO $ getDirectoryContentsRecursive dir
         forM_ contents (deleteFile . (dir </>))
 
@@ -1679,6 +1757,7 @@ compileGHC :: ( MonadMask m
            -> [Text]                   -- ^ additional args to ./configure
            -> Maybe String             -- ^ build flavour
            -> Bool
+           -> Maybe FilePath           -- ^ isolate dir
            -> Excepts
                 '[ AlreadyInstalled
                  , BuildFailed
@@ -1691,13 +1770,12 @@ compileGHC :: ( MonadMask m
                  , UnknownArchive
                  , TarDirDoesNotExist
                  , NotInstalled
-#if !defined(TAR)
+                 , DirNotEmpty
                  , ArchiveResult
-#endif
                  ]
                 m
                 GHCTargetVersion
-compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian
+compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour hadrian isolateDir
   = do
     PlatformRequest { .. } <- lift getPlatformReq
     GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
@@ -1705,7 +1783,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
     (workdir, tmpUnpack, tver) <- case targetGhc of
       -- unpack from version tarball
       Left tver -> do
-        lift $ $(logDebug) [i|Requested to compile: #{tver} with #{bstrap}|]
+        lift $ $(logDebug) $ "Requested to compile: " <> tVerToText tver <> " with " <> either prettyVer T.pack bstrap
 
         -- download source tarball
         dlInfo <-
@@ -1716,7 +1794,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
         -- unpack
         tmpUnpack <- lift mkGhcupTmpDir
         liftE $ unpackToDir tmpUnpack dl
-        void $ lift $ darwinNotarization _rPlatform tmpUnpack
+        liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
 
         workdir <- maybe (pure tmpUnpack)
                          (liftE . intoSubdir tmpUnpack)
@@ -1730,7 +1808,7 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
         let git args = execLogged "git" ("--no-pager":args) (Just tmpUnpack) "git" Nothing
         tver <- reThrowAll @_ @'[ProcessError] DownloadFailed $ do
           let rep = fromMaybe "https://gitlab.haskell.org/ghc/ghc.git" repo
-          lift $ $(logInfo) [i|Fetching git repo #{rep} at ref #{ref} (this may take a while)|]
+          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"
@@ -1756,8 +1834,8 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
             ExitSuccess -> throwEither . MP.parse ghcProjectVersion "" . decUTF8Safe' $ _stdOut
             ExitFailure c -> fail ("Could not figure out GHC project version. Exit code was: " <> show c <> ". Error was: " <> T.unpack (decUTF8Safe' _stdErr))
 
-        void $ lift $ darwinNotarization _rPlatform tmpUnpack
+        liftE $ catchWarn $ lEM @_ @'[ProcessError] $ darwinNotarization _rPlatform tmpUnpack
-        lift $ $(logInfo) [i|Git version #{ref} corresponds to GHC version #{prettyVer tver}|]
+        lift $ $(logInfo) $ "Git version " <> T.pack ref <> " corresponds to GHC version " <> prettyVer tver
 
         pure (tmpUnpack, tmpUnpack, GHCTargetVersion Nothing tver)
     -- the version that's installed may differ from the
@@ -1767,12 +1845,18 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
     alreadyInstalled <- lift $ ghcInstalled installVer
     alreadySet <- fmap (== Just tver) $ lift $ ghcSet (_tvTarget tver)
     when alreadyInstalled $ do
-      lift $ $(logWarn) [i|GHC #{prettyShow tver} already installed. Will overwrite existing version.|]
+      case isolateDir of
+        Just isoDir ->
+          lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Isolate installing to " <> T.pack isoDir
+        Nothing ->
+          lift $ $(logWarn) $ "GHC " <> T.pack (prettyShow tver) <> " already installed. Will overwrite existing version."
       lift $ $(logWarn)
         "...waiting for 10 seconds before continuing, you can still abort..."
       liftIO $ threadDelay 10000000 -- give the user a sec to intervene
 
-    ghcdir         <- lift $ ghcupGHCDir installVer
+    ghcdir <- case isolateDir of
+      Just isoDir -> pure isoDir
+      Nothing -> lift $ ghcupGHCDir installVer
 
     bghc <- case bstrap of
       Right g    -> pure $ Right g
@@ -1789,10 +1873,15 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
         pure (b, bmk)
       )
 
+    case isolateDir of
+      Nothing ->
+        -- only remove old ghc in regular installs
         when alreadyInstalled $ do
-      lift $ $(logInfo) [i|Deleting existing installation|]
+          lift $ $(logInfo) "Deleting existing installation"
           liftE $ rmGHCVer tver
           
+      _ -> pure ()
+
     forM_ mBindist $ \bindist -> do
       liftE $ installPackedGHC bindist
                                (Just $ RegexDir "ghc-.*")
@@ -1801,11 +1890,15 @@ compileGHC targetGhc ov bstrap jobs mbuildConfig patchdir aargs buildFlavour had
 
     liftIO $ B.writeFile (ghcdir </> ghcUpSrcBuiltFile) bmk
     
+    case isolateDir of
+      -- set and make symlinks for regular (non-isolated) installs
+      Nothing -> do
         reThrowAll GHCupSetError $ postGHCInstall tver
-
         -- restore
         when alreadySet $ liftE $ void $ setGHC tver SetGHCOnly
         
+      _ -> pure ()
+
     pure tver
 
  where
@@ -1859,11 +1952,11 @@ endif|]
 
     liftE $ configureBindist bghc tver workdir ghcdir
 
-    lift $ $(logInfo) [i|Building (this may take a while)...|]
+    lift $ $(logInfo) "Building (this may take a while)..."
     hadrian_build <- liftE $ findHadrianFile workdir
     lEM $ execLogged hadrian_build
-                          ( maybe [] (\j  -> [[i|-j#{j}|]]         ) jobs
+                          ( maybe [] (\j  -> ["-j" <> show j]         ) jobs
-                         ++ maybe [] (\bf -> [[i|--flavour=#{bf}|]]) buildFlavour
+                         ++ maybe [] (\bf -> ["--flavour=" <> bf]) buildFlavour
                          ++ ["binary-dist"]
                           )
                           (Just workdir) "ghc-make" Nothing
@@ -1925,19 +2018,19 @@ endif|]
         (FileDoesNotExistError bc)
         (liftIO $ copyFile bc (build_mk workdir))
       Nothing ->
-        liftIO $ B.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf)
+        liftIO $ T.writeFile (build_mk workdir) (addBuildFlavourToConf defaultConf)
 
     liftE $ checkBuildConfig (build_mk workdir)
 
-    lift $ $(logInfo) [i|Building (this may take a while)...|]
+    lift $ $(logInfo) "Building (this may take a while)..."
     lEM $ make (maybe [] (\j -> ["-j" <> fS (show j)]) jobs) (Just workdir)
 
     if | isCross tver -> do
-          lift $ $(logInfo) [i|Installing cross toolchain...|]
+          lift $ $(logInfo) "Installing cross toolchain..."
           lEM $ make ["install"] (Just workdir)
           pure Nothing
        | otherwise -> do
-          lift $ $(logInfo) [i|Creating bindist...|]
+          lift $ $(logInfo) "Creating bindist..."
           lEM $ make ["binary-dist"] (Just workdir)
           [tar] <- liftIO $ findFiles
             workdir
@@ -1978,11 +2071,20 @@ endif|]
       . SHA256.hashlazy
       $ c
     cTime <- liftIO getCurrentTime
-    let tarName = makeValid [i|ghc-#{tVerToText tver}-#{pfReqToString pfreq}-#{iso8601Show cTime}-#{cDigest}.tar#{takeExtension tar}|]
+    let tarName = makeValid ("ghc-"
+                            <> T.unpack (tVerToText tver)
+                            <> "-"
+                            <> pfReqToString pfreq
+                            <> "-"
+                            <> iso8601Show cTime
+                            <> "-"
+                            <> T.unpack cDigest
+                            <> ".tar"
+                            <> takeExtension tar)
     let tarPath = cacheDir </> tarName
     handleIO (throwE . CopyError . show) $ liftIO $ copyFile (workdir </> tar)
                                                              tarPath
-    lift $ $(logInfo) [i|Copied bindist to #{tarPath}|]
+    lift $ $(logInfo) $ "Copied bindist to " <> T.pack tarPath
     pure tarPath
 
   checkBuildConfig :: (MonadCatch m, MonadIO m, MonadLogger m)
@@ -2007,13 +2109,12 @@ endif|]
       _ -> pure ()
 
     forM_ buildFlavour $ \bf ->
-      when ([i|BuildFlavour = #{bf}|] `notElem` lines') $ do
+      when (T.pack ("BuildFlavour = " <> bf) `notElem` lines') $ do
-        lift $ $(logWarn) [i|Customly specified build config overwrites --flavour=#{bf} switch! Waiting 5 seconds...|]
+        lift $ $(logWarn) $ "Customly specified build config overwrites --flavour=" <> T.pack bf <> " switch! Waiting 5 seconds..."
         liftIO $ threadDelay 5000000
 
   addBuildFlavourToConf bc = case buildFlavour of
-    Just bf -> [i|BuildFlavour = #{bf}|] <> [s|
+    Just bf -> "BuildFlavour = " <> T.pack bf <> "\n" <> bc
-|] <> [i|#{bc}|]
     Nothing -> bc
 
   isCross :: GHCTargetVersion -> Bool
@@ -2131,29 +2232,37 @@ upgradeGHCup mtarget force' = do
   Dirs {..} <- lift getDirs
   GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
 
-  lift $ $(logInfo) [i|Upgrading GHCup...|]
+  lift $ $(logInfo) "Upgrading GHCup..."
   let latestVer = fromJust $ fst <$> getLatest dls GHCup
   when (not force' && (latestVer <= pvpToVersion ghcUpVer)) $ throwE NoUpdate
   dli   <- liftE $ getDownloadInfo GHCup latestVer
   tmp   <- lift withGHCupTmpDir
   let fn = "ghcup" <> exeExt
-  p <- liftE $ download dli tmp (Just fn)
+  p <- liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp (Just fn) False
   let destDir = takeDirectory destFile
       destFile = fromMaybe (binDir </> fn) mtarget
-  lift $ $(logDebug) [i|mkdir -p #{destDir}|]
+  lift $ $(logDebug) $ "mkdir -p " <> T.pack destDir
   liftIO $ createDirRecursive' destDir
-  lift $ $(logDebug) [i|rm -f #{destFile}|]
+  lift $ $(logDebug) $ "rm -f " <> T.pack destFile
   lift $ hideError NoSuchThing $ recycleFile destFile
-  lift $ $(logDebug) [i|cp #{p} #{destFile}|]
+  lift $ $(logDebug) $ "cp " <> T.pack p <> " " <> T.pack destFile
   handleIO (throwE . CopyError . show) $ liftIO $ copyFile p
                                                            destFile
   lift $ chmod_755 destFile
 
   liftIO (isInPath destFile) >>= \b -> unless b $
-    lift $ $(logWarn) [i|"#{takeFileName destFile}" is not in PATH! You have to add it in order to use ghcup.|]
+    lift $ $(logWarn) $ T.pack (takeFileName destFile) <> " is not in PATH! You have to add it in order to use ghcup."
   liftIO (isShadowed destFile) >>= \case
     Nothing -> pure ()
-    Just pa -> lift $ $(logWarn) [i|ghcup is shadowed by "#{pa}". The upgrade will not be in effect, unless you remove "#{pa}" or make sure "#{destDir}" comes before "#{takeFileName pa}" in PATH.|]
+    Just pa -> lift $ $(logWarn) $ "ghcup is shadowed by "
+      <> T.pack pa
+      <> ". The upgrade will not be in effect, unless you remove "
+      <> T.pack pa
+      <> " or make sure "
+      <> T.pack destDir
+      <> " comes before "
+      <> T.pack (takeFileName pa)
+      <> " in PATH."
 
   pure latestVer
 
@@ -2164,6 +2273,7 @@ upgradeGHCup mtarget force' = do
     -------------
 
 
+
 -- | Creates @ghc-x.y.z@ and @ghc-x.y@ symlinks. This is used for
 -- both installing from source and bindist.
 postGHCInstall :: ( MonadReader env m
@@ -2184,7 +2294,7 @@ postGHCInstall ver@GHCTargetVersion {..} = do
   -- Create ghc-x.y symlinks. This may not be the current
   -- version, create it regardless.
   v' <-
-    handle (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
+    handle (\(e :: ParseError) -> lift $ $(logWarn) (T.pack $ displayException e) >> pure Nothing)
     $ fmap Just
     $ getMajorMinorV _tvVersion
   forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi _tvTarget)
@@ -2238,4 +2348,3 @@ whereIsTool tool ver@GHCTargetVersion {..} = do
       liftIO $ canonicalizePath currentRunningExecPath
 
 
-

lib/GHCup/Download.hs

@@ -55,20 +55,18 @@ import           Data.Aeson
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
 #if defined(INTERNAL_DOWNLOADER)
-import           Data.CaseInsensitive           ( CI )
+import           Data.CaseInsensitive           ( mk )
 #endif
 import           Data.List.Extra
 import           Data.Maybe
-import           Data.String.Interpolate
 import           Data.Time.Clock
 import           Data.Time.Clock.POSIX
-#if defined(INTERNAL_DOWNLOADER)
-import           Data.Time.Format
-#endif
 import           Data.Versions
-import           Data.Word8
+import           Data.Word8              hiding ( isSpace )
-import           GHC.IO.Exception
 import           Haskus.Utils.Variant.Excepts
+#if defined(INTERNAL_DOWNLOADER)
+import           Network.Http.Client     hiding ( URL )
+#endif
 import           Optics
 import           Prelude                 hiding ( abs
                                                 , readFile
@@ -76,8 +74,11 @@ import           Prelude                 hiding ( abs
                                                 )
 import           System.Directory
 import           System.Environment
+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
@@ -85,10 +86,8 @@ import qualified Data.ByteString               as B
 import qualified Data.ByteString.Base16        as B16
 import qualified Data.ByteString.Lazy          as L
 import qualified Data.Map.Strict               as M
-#if defined(INTERNAL_DOWNLOADER)
-import qualified Data.CaseInsensitive          as CI
-#endif
 import qualified Data.Text                     as T
+import qualified Data.Text.IO                  as T
 import qualified Data.Text.Encoding            as E
 import qualified Data.Yaml                     as Y
 
@@ -149,19 +148,14 @@ getDownloadsF = do
     in GHCupInfo tr newDownloads newGlobalTools
 
 
-readFromCache :: ( MonadReader env m
+yamlFromCache :: (MonadReader env m, HasDirs env) => URI -> m FilePath
-                 , HasDirs env
+yamlFromCache uri = do
-                 , MonadIO m
+  Dirs{..} <- getDirs
-                 , MonadCatch m)
+  pure (cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri))
-              => URI
+
-              -> Excepts '[JSONError, FileDoesNotExistError] m L.ByteString
+
-readFromCache uri = do
+etagsFile :: FilePath -> FilePath
-  Dirs{..} <- lift getDirs
+etagsFile = (<.> "etags")
-  let yaml_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName . view pathL' $ uri)
-  handleIO' NoSuchThing (\_ -> throwE $ FileDoesNotExistError yaml_file)
-    . liftIO
-    . L.readFile
-    $ yaml_file
 
 
 getBase :: ( MonadReader env m
@@ -174,33 +168,51 @@ getBase :: ( MonadReader env m
            , MonadMask m
            )
         => URI
-        -> Excepts '[JSONError , FileDoesNotExistError] m GHCupInfo
+        -> Excepts '[JSONError] m GHCupInfo
 getBase uri = do
   Settings { noNetwork } <- lift getSettings
-  bs <- if noNetwork
+
-        then readFromCache uri
+  -- try to download yaml... usually this writes it into cache dir,
-        else handleIO (\_ -> warnCache >> readFromCache uri)
+  -- but in some cases not (e.g. when using file://), so we honour
-               . catchE @_ @'[JSONError, FileDoesNotExistError] (\(DownloadFailed _) -> warnCache >> readFromCache uri)
+  -- the return filepath, if any
-               . reThrowAll @_ @_ @'[JSONError, DownloadFailed] DownloadFailed
+  mYaml <- if noNetwork && view (uriSchemeL' % schemeBSL') uri /= "file" -- for file://, let it fall through
-               $ smartDl uri
+           then pure Nothing
+           else handleIO (\e -> warnCache (displayException e) >> pure Nothing)
+               . catchE @_ @_ @'[] (\e@(DownloadFailed _) -> warnCache (prettyShow e) >> pure Nothing)
+               . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed
+               . fmap Just
+               . smartDl
+               $ uri
+
+  -- if we didn't get a filepath from the download, use the cached yaml
+  actualYaml <- maybe (lift $ yamlFromCache uri) pure mYaml
+  lift $ $(logDebug) $ "Decoding yaml at: " <> T.pack actualYaml
+
   liftE
-    . lE' @_ @_ @'[JSONError] JSONDecodeError
+    . onE_ (onError actualYaml)
-    . first show
+    . lEM' @_ @_ @'[JSONError] JSONDecodeError
-    . Y.decodeEither'
+    . fmap (first (\e -> unlines [displayException e
-    . L.toStrict
+                                 ,"Consider removing " <> actualYaml <> " manually."]))
-    $ bs
+    . liftIO
+    . Y.decodeFileEither
+    $ actualYaml
  where
-  warnCache = lift $ $(logWarn)
+  -- On error, remove the etags file and set access time to 0. This should ensure the next invocation
-      [i|Could not get download info, trying cached version (this may not be recent!)|]
+  -- may re-download and succeed.
+  onError :: (MonadLogger m, MonadMask m, MonadCatch m, MonadIO m) => FilePath -> m ()
+  onError fp = do
+    let efp = etagsFile fp
+    handleIO (\e -> $(logWarn) $ "Couldn't remove file " <> T.pack efp <> ", error was: " <> T.pack (displayException e))
+      (hideError doesNotExistErrorType $ rmFile efp)
+    liftIO $ hideError doesNotExistErrorType $ setAccessTime fp (posixSecondsToUTCTime (fromIntegral @Int 0))
+  warnCache s = do
+    lift $ $(logWarn) "Could not get download info, trying cached version (this may not be recent!)"
+    lift $ $(logDebug) $ "Error was: " <> T.pack s
 
   -- First check if the json file is in the ~/.ghcup/cache dir
   -- and check it's access time. If it has been accessed within the
   -- last 5 minutes, just reuse it.
   --
-  -- If not, then send a HEAD request and check for modification time.
-  -- Only download the file if the modification time is newer
-  -- than the local file.
-  --
   -- Always save the local file with the mod time of the remote file.
   smartDl :: forall m1 env1
            . ( MonadReader env1 m1
@@ -214,92 +226,36 @@ getBase uri = do
              )
           => URI
           -> Excepts
-               '[ FileDoesNotExistError
+               '[ DownloadFailed
-                , HTTPStatusError
+                , DigestError
-                , URIParseError
-                , UnsupportedScheme
-                , NoLocationHeader
-                , TooManyRedirs
-                , ProcessError
-                , NoNetwork
                 ]
                m1
-               L.ByteString
+               FilePath
   smartDl uri' = do
-    Dirs{..} <- lift getDirs
+    json_file <- lift $ yamlFromCache uri'
-    let path = view pathL' uri'
+    let scheme = view (uriSchemeL' % schemeBSL') uri'
-    let json_file = cacheDir </> (T.unpack . decUTF8Safe . urlBaseName $ path)
     e <- liftIO $ doesFileExist json_file
-    if e
-      then do
-        accessTime <- liftIO $ getAccessTime json_file
     currentTime <- liftIO getCurrentTime
+    Dirs { cacheDir } <- lift getDirs
+
+       -- for local files, let's short-circuit and ignore access time
+    if | scheme == "file" -> liftE $ download uri' Nothing cacheDir Nothing True
+       | e -> do
+          accessTime <- liftIO $ getAccessTime json_file
 
           -- access time won't work on most linuxes, but we can try regardless
-        if (utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300
+          if | ((utcTimeToPOSIXSeconds currentTime - utcTimeToPOSIXSeconds accessTime) > 300) ->
-          then do -- no access in last 5 minutes, re-check upstream mod time
+                -- no access in last 5 minutes, re-check upstream mod time
-            getModTime >>= \case
+                dlWithMod currentTime json_file
-              Just modTime -> do
+             | otherwise -> pure json_file
-                fileMod <- liftIO $ getModificationTime json_file
+       | otherwise -> dlWithMod currentTime json_file
-                if modTime > fileMod
-                  then dlWithMod modTime json_file
-                  else liftIO $ L.readFile json_file
-              Nothing -> do
-                lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
-                dlWithoutMod json_file
-          else -- access in less than 5 minutes, re-use file
-               liftIO $ L.readFile json_file
-      else do
-        getModTime >>= \case
-          Just modTime -> dlWithMod modTime json_file
-          Nothing -> do
-            -- although we don't know last-modified, we still save
-            -- it to a file, so we might use it in offline mode
-            lift $ $(logDebug) [i|Unable to get/parse Last-Modified header|]
-            dlWithoutMod json_file
-
    where
     dlWithMod modTime json_file = do
-      bs <- liftE $ downloadBS uri'
+      let (dir, fn) = splitFileName json_file
-      liftIO $ writeFileWithModTime modTime json_file bs
+      f <- liftE $ download uri' Nothing dir (Just fn) True
-      pure bs
+      liftIO $ setModificationTime f modTime
-    dlWithoutMod json_file = do
+      liftIO $ setAccessTime f modTime
-      bs <- liftE $ downloadBS uri'
+      pure f
-      lift $ hideError doesNotExistErrorType $ recycleFile json_file
-      liftIO $ L.writeFile json_file bs
-      liftIO $ setModificationTime json_file (posixSecondsToUTCTime (fromIntegral @Int 0))
-      pure bs
-
-
-    getModTime = do
-#if !defined(INTERNAL_DOWNLOADER)
-      pure Nothing
-#else
-      headers <-
-        handleIO (\_ -> pure mempty)
-        $ liftE
-        $ ( catchAllE
-              (\_ ->
-                pure mempty :: Excepts '[] m1 (M.Map (CI ByteString) ByteString)
-              )
-          $ getHead uri'
-          )
-      pure $ parseModifiedHeader headers
-
-  parseModifiedHeader :: (M.Map (CI ByteString) ByteString) -> Maybe UTCTime
-  parseModifiedHeader headers =
-    (M.lookup (CI.mk "Last-Modified") headers) >>= \h -> parseTimeM
-      True
-      defaultTimeLocale
-      "%a, %d %b %Y %H:%M:%S %Z"
-      (T.unpack . decUTF8Safe $ h)
-
-#endif
-
-  writeFileWithModTime :: UTCTime -> FilePath -> L.ByteString -> IO ()
-  writeFileWithModTime utctime path content = do
-    L.writeFile path content
-    setModificationTime path utctime
 
 
 getDownloadInfo :: ( MonadReader env m
@@ -359,32 +315,30 @@ download :: ( MonadReader env m
             , MonadLogger m
             , MonadIO m
             )
-         => DownloadInfo
+         => URI
-         -> FilePath          -- ^ destination dir
+         -> Maybe T.Text      -- ^ expected hash
+         -> FilePath          -- ^ destination dir (ignored for file:// scheme)
          -> Maybe FilePath    -- ^ optional filename
+         -> Bool              -- ^ whether to read an write etags
          -> Excepts '[DigestError , DownloadFailed] m FilePath
-download dli dest mfn
+download uri eDigest dest mfn etags
   | scheme == "https" = dl
   | scheme == "http"  = dl
-  | scheme == "file"  = cp
+  | scheme == "file"  = do
+      let destFile' = T.unpack . decUTF8Safe $ path
+      lift $ $(logDebug) $ "using local file: " <> T.pack destFile'
+      forM_ eDigest (liftE . flip checkDigest destFile')
+      pure destFile'
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
 
  where
-  scheme = view (dlUri % uriSchemeL' % schemeBSL') dli
+  scheme = view (uriSchemeL' % schemeBSL') uri
-  cp     = do
-    -- destination dir must exist
-    liftIO $ createDirRecursive' dest
-    let destFile = getDestFile
-    let fromFile = T.unpack . decUTF8Safe $ path
-    liftIO $ copyFile fromFile destFile
-    pure destFile
   dl = do
-    let uri' = decUTF8Safe (serializeURIRef' (view dlUri dli))
+    destFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile
-    lift $ $(logInfo) [i|downloading: #{uri'}|]
+    lift $ $(logInfo) $ "downloading: " <> uri' <> " as file " <> T.pack destFile
 
     -- destination dir must exist
     liftIO $ createDirRecursive' dest
-    let destFile = getDestFile
 
     -- download
     flip onException
@@ -399,28 +353,140 @@ download dli dest mfn
               case downloader of
                 Curl -> do
                   o' <- liftIO getCurlOpts
+                  if etags
+                    then do
+                      dh <- liftIO $ emptySystemTempFile "curl-header"
+                      flip finally (try @_ @SomeException $ rmFile dh) $
+                        flip finally (try @_ @SomeException $ rmFile (destFile <.> "tmp")) $ do
+                          metag <- readETag destFile
                           liftE $ lEM @_ @'[ProcessError] $ exec "curl"
-                    (o' ++ ["-fL", "-o", destFile, (T.unpack . decUTF8Safe) $ serializeURIRef' $ view dlUri dli]) Nothing Nothing
+                              (o' ++ (if etags then ["--dump-header", dh] else [])
+                                  ++ maybe [] (\t -> ["-H", "If-None-Match: " <> T.unpack t]) metag
+                                  ++ ["-fL", "-o", destFile <.> "tmp", T.unpack uri']) Nothing Nothing
+                          headers <- liftIO $ T.readFile dh
+
+                          -- this nonsense is necessary, because some older versions of curl would overwrite
+                          -- the destination file when 304 is returned
+                          case fmap T.words . listToMaybe . fmap T.strip . T.lines . getLastHeader $ headers of
+                            Just (http':sc:_)
+                              | sc == "304"
+                              , T.pack "HTTP" `T.isPrefixOf` http' -> $logDebug "Status code was 304, not overwriting"
+                              | T.pack "HTTP" `T.isPrefixOf` http' -> do
+                                  $logDebug $ "Status code was " <> sc <> ", overwriting"
+                                  liftIO $ copyFile (destFile <.> "tmp") destFile
+                            _ -> liftE $ throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 (MalformedHeaders headers)
+                              :: V '[MalformedHeaders]))
+
+                          writeEtags destFile (parseEtags headers)
+                    else
+                      liftE $ lEM @_ @'[ProcessError] $ exec "curl" 
+                        (o' ++ ["-fL", "-o", destFile, T.unpack uri']) Nothing Nothing
                 Wget -> do
+                  destFileTemp <- liftIO $ emptySystemTempFile "wget-tmp"
+                  flip finally (try @_ @SomeException $ rmFile destFileTemp) $ do
                     o' <- liftIO getWgetOpts
-                  liftE $ lEM @_ @'[ProcessError] $ exec "wget" 
+                    if etags
-                    (o' ++ ["-O", destFile , (T.unpack . decUTF8Safe) $ serializeURIRef' $ view dlUri dli]) Nothing Nothing
+                      then do
+                        metag <- readETag destFile
+                        let opts = o' ++ maybe [] (\t -> ["--header", "If-None-Match: " <> T.unpack t]) metag
+                                      ++ ["-q", "-S", "-O", destFileTemp , T.unpack uri']
+                        CapturedProcess {_exitCode, _stdErr} <- lift $ executeOut "wget" opts Nothing
+                        case _exitCode of
+                          ExitSuccess -> do
+                            liftIO $ copyFile destFileTemp destFile
+                            writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
+                          ExitFailure i'
+                            | i' == 8
+                            , Just _ <- find (T.pack "304 Not Modified" `T.isInfixOf`) . T.lines . decUTF8Safe' $ _stdErr
+                                     -> do
+                                          $logDebug "Not modified, skipping download"
+                                          writeEtags destFile (parseEtags (decUTF8Safe' _stdErr))
+                            | otherwise -> throwE (NonZeroExit i' "wget" opts)
+                      else do
+                        let opts = o' ++ ["-O", destFileTemp , T.unpack uri']
+                        liftE $ lEM @_ @'[ProcessError] $ exec "wget" opts Nothing Nothing
+                        liftIO $ copyFile destFileTemp destFile
 #if defined(INTERNAL_DOWNLOADER)
                 Internal -> do
-                  (https, host, fullPath, port) <- liftE $ uriToQuadruple (view dlUri dli)
+                  (https, host, fullPath, port) <- liftE $ uriToQuadruple uri
-                  liftE $ downloadToFile https host fullPath port destFile
+                  if etags
+                    then do
+                      metag <- readETag destFile
+                      let addHeaders = maybe mempty (\etag -> M.fromList [ (mk . E.encodeUtf8 . T.pack $ "If-None-Match"
+                                                                         , E.encodeUtf8 etag)]) metag
+                      liftE
+                        $ catchE @HTTPNotModified @'[DownloadFailed] @'[] (\(HTTPNotModified etag) -> lift $ writeEtags destFile (pure $ Just etag))
+                        $ do
+                          r <- downloadToFile https host fullPath port destFile addHeaders
+                          writeEtags destFile (pure $ decUTF8Safe <$> getHeader r "etag")
+                    else void $ liftE $ catchE @HTTPNotModified
+                                        @'[DownloadFailed]
+                                   (\e@(HTTPNotModified _) ->
+                                     throwE @_ @'[DownloadFailed] (DownloadFailed (toVariantAt @0 e :: V '[HTTPNotModified])))
+                               $ downloadToFile https host fullPath port destFile mempty
 #endif
 
-    liftE $ checkDigest dli destFile
+    forM_ eDigest (liftE . flip checkDigest destFile)
     pure destFile
 
-  -- Manage to find a file we can write the body into.
-  getDestFile :: FilePath
-  getDestFile = maybe (dest </> T.unpack (decUTF8Safe (urlBaseName path)))
-                  (dest </>)
-                  mfn
 
-  path = view (dlUri % pathL') dli
+  -- Manage to find a file we can write the body into.
+  getDestFile :: Monad m => Excepts '[NoUrlBase] m FilePath
+  getDestFile = 
+    case mfn of
+        Just fn -> pure (dest </> fn)
+        Nothing
+          | let urlBase = T.unpack (decUTF8Safe (urlBaseName path))
+          , not (null urlBase) -> pure (dest </> urlBase)
+          -- TODO: remove this once we use hpath again
+          | otherwise -> throwE $ NoUrlBase uri'
+
+  path = view pathL' uri
+  uri' = decUTF8Safe (serializeURIRef' uri)
+
+  parseEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => T.Text -> m (Maybe T.Text)
+  parseEtags stderr = do
+    let mEtag = find (\line -> T.pack "etag:" `T.isPrefixOf` T.toLower line) . fmap T.strip . T.lines . getLastHeader $ stderr
+    case T.words <$> mEtag of
+      (Just []) -> do
+        $logDebug "Couldn't parse etags, no input: "
+        pure Nothing
+      (Just [_, etag']) -> do
+        $logDebug $ "Parsed etag: " <> etag'
+        pure (Just etag')
+      (Just xs) -> do
+        $logDebug ("Couldn't parse etags, unexpected input: " <> T.unwords xs)
+        pure Nothing
+      Nothing -> do
+        $logDebug "No etags header found"
+        pure Nothing
+
+  writeEtags :: (MonadLogger m, MonadIO m, MonadThrow m) => FilePath -> m (Maybe T.Text) -> m ()
+  writeEtags destFile getTags = do
+    getTags >>= \case
+      Just t -> do
+        $logDebug $ "Writing etagsFile " <> T.pack (etagsFile destFile)
+        liftIO $ T.writeFile (etagsFile destFile) t
+      Nothing ->
+        $logDebug "No etags files written"
+
+  readETag :: (MonadLogger m, MonadCatch m, MonadIO m) => FilePath -> m (Maybe T.Text)
+  readETag fp = do
+    e <- liftIO $ doesFileExist fp
+    if e
+    then do
+      rE <- try @_ @SomeException $ liftIO $ fmap stripNewline' $ T.readFile (etagsFile fp)
+      case rE of
+        (Right et) -> do
+          $logDebug $ "Read etag: " <> et
+          pure (Just et)
+        (Left _) -> do
+          $logDebug "Etag file doesn't exist (yet)"
+          pure Nothing
+    else do
+      $logDebug $ "Skipping and deleting etags file because destination file " <> T.pack fp <> " doesn't exist"
+      liftIO $ hideError doesNotExistErrorType $ rmFile (etagsFile fp)
+      pure Nothing
 
 
 -- | Download into tmpdir or use cached version, if it exists. If filename
@@ -444,7 +510,7 @@ downloadCached dli mfn = do
     True -> downloadCached' dli mfn Nothing
     False -> do
       tmp <- lift withGHCupTmpDir
-      liftE $ download dli tmp mfn
+      liftE $ download (_dlUri dli) (Just (_dlHash dli)) tmp mfn False
 
 
 downloadCached' :: ( MonadReader env m
@@ -468,9 +534,9 @@ downloadCached' dli mfn mDestDir = do
   fileExists <- liftIO $ doesFileExist cachfile
   if
     | fileExists -> do
-      liftE $ checkDigest dli cachfile
+      liftE $ checkDigest (view dlHash dli) cachfile
       pure cachfile
-    | otherwise -> liftE $ download dli destDir mfn
+    | otherwise -> liftE $ download (_dlUri dli) (Just (_dlHash dli)) destDir mfn False
 
 
 
@@ -481,73 +547,6 @@ downloadCached' dli mfn mDestDir = do
 
 
 
-
--- | This is used for downloading the JSON.
-downloadBS :: ( MonadReader env m
-              , HasSettings env
-              , MonadCatch m
-              , MonadIO m
-              , MonadLogger m
-              )
-           => URI
-           -> Excepts
-                '[ FileDoesNotExistError
-                 , HTTPStatusError
-                 , URIParseError
-                 , UnsupportedScheme
-                 , NoLocationHeader
-                 , TooManyRedirs
-                 , ProcessError
-                 , NoNetwork
-                 ]
-                m
-                L.ByteString
-downloadBS uri'
-  | scheme == "https"
-  = dl True
-  | scheme == "http"
-  = dl False
-  | scheme == "file"
-  = liftIOException doesNotExistErrorType (FileDoesNotExistError $ T.unpack $ decUTF8Safe path)
-    (liftIO $ L.readFile (T.unpack $ decUTF8Safe path))
-  | otherwise
-  = throwE UnsupportedScheme
-
- where
-  scheme = view (uriSchemeL' % schemeBSL') uri'
-  path   = view pathL' uri'
-#if defined(INTERNAL_DOWNLOADER)
-  dl https = do
-#else
-  dl _ = do
-#endif
-    lift $ $(logDebug) [i|downloading: #{serializeURIRef' uri'}|]
-    Settings{ downloader, noNetwork } <- lift getSettings
-    when noNetwork $ throwE NoNetwork
-    case downloader of
-      Curl -> do
-        o' <- liftIO getCurlOpts
-        let exe = "curl"
-            args = o' ++ ["-sSfL", T.unpack $ decUTF8Safe $ serializeURIRef' uri']
-        lift (executeOut exe args Nothing) >>= \case
-          CapturedProcess ExitSuccess stdout _ -> do
-            pure stdout
-          CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' exe args
-      Wget -> do
-        o' <- liftIO getWgetOpts
-        let exe = "wget"
-            args = o' ++ ["-qO-", T.unpack $ decUTF8Safe $ serializeURIRef' uri']
-        lift (executeOut exe args Nothing) >>= \case
-          CapturedProcess ExitSuccess stdout _ -> do
-            pure stdout
-          CapturedProcess (ExitFailure i') _ _ -> throwE $ NonZeroExit i' exe args
-#if defined(INTERNAL_DOWNLOADER)
-      Internal -> do
-        (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
-        liftE $ downloadBS' https host' fullPath' port'
-#endif
-
-
 checkDigest :: ( MonadReader env m
                , HasDirs env
                , HasSettings env
@@ -555,18 +554,17 @@ checkDigest :: ( MonadReader env m
                , MonadThrow m
                , MonadLogger m
                )
-            => DownloadInfo
+            => T.Text     -- ^ the hash
             -> FilePath
             -> Excepts '[DigestError] m ()
-checkDigest dli file = do
+checkDigest eDigest file = do
   Settings{ noVerify } <- lift getSettings
   let verify = not noVerify
   when verify $ do
     let p' = takeFileName file
-    lift $ $(logInfo) [i|verifying digest of: #{p'}|]
+    lift $ $(logInfo) $ "verifying digest of: " <> T.pack p'
     c <- liftIO $ L.readFile file
     cDigest <- throwEither . E.decodeUtf8' . B16.encode . SHA256.hashlazy $ c
-    let eDigest = view dlHash dli
     when ((cDigest /= eDigest) && verify) $ throwE (DigestError cDigest eDigest)
 
 
@@ -586,7 +584,23 @@ getWgetOpts =
     Nothing -> pure []
 
 
+-- | Get the url base name.
+--
+-- >>> urlBaseName "/foo/bar/baz"
+-- "baz"
 urlBaseName :: ByteString  -- ^ the url path (without scheme and host)
             -> ByteString
 urlBaseName = snd . B.breakEnd (== _slash) . urlDecode False
 
+
+-- | Curl saves all intermediate connect headers as well, not just the last one, so we make an effort to take the
+-- last HTTP block only. Passing '--suppress-connect-headers' would be better, but it isn't supported by all versions,
+-- also see:
+--   https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/213
+--
+-- >>> getLastHeader "\n\nHTTP/1.0 200 Connection established\n\nHTTP/1.1 304 Not Modified\n"
+-- "HTTP/1.1 304 Not Modified\n"
+-- >>> getLastHeader "HTTP/1.1 304 Not Modified\n"
+-- "HTTP/1.1 304 Not Modified\n"
+getLastHeader :: T.Text -> T.Text
+getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [""] . fmap T.stripEnd . T.lines

lib/GHCup/Download/IOStreams.hs

@@ -9,9 +9,7 @@ module GHCup.Download.IOStreams where
 
 import           GHCup.Download.Utils
 import           GHCup.Errors
-import           GHCup.Types.Optics
 import           GHCup.Types.JSON               ( )
-import           GHCup.Utils.File
 import           GHCup.Utils.Prelude
 
 import           Control.Applicative
@@ -20,7 +18,7 @@ import           Control.Monad
 import           Control.Monad.Reader
 import           Data.ByteString                ( ByteString )
 import           Data.ByteString.Builder
-import           Data.CaseInsensitive           ( CI )
+import           Data.CaseInsensitive           ( CI, original, mk )
 import           Data.IORef
 import           Data.Maybe
 import           Data.Text.Read
@@ -32,7 +30,6 @@ import           Prelude                 hiding ( abs
                                                 , writeFile
                                                 )
 import           System.ProgressBar
-import           System.IO
 import           URI.ByteString
 
 import qualified Data.ByteString               as BS
@@ -67,7 +64,7 @@ downloadBS' :: MonadIO m
 downloadBS' https host path port = do
   bref <- liftIO $ newIORef (mempty :: Builder)
   let stepper bs = modifyIORef bref (<> byteString bs)
-  downloadInternal False https host path port stepper
+  void $ downloadInternal False https host path port stepper (pure ()) mempty
   liftIO (readIORef bref <&> toLazyByteString)
 
 
@@ -77,12 +74,17 @@ downloadToFile :: (MonadMask m, MonadIO m)
                -> ByteString       -- ^ path (e.g. "/my/file") including query
                -> Maybe Int        -- ^ optional port (e.g. 3000)
                -> FilePath         -- ^ destination file to create and write to
-               -> Excepts '[DownloadFailed] m ()
+               -> M.Map (CI ByteString) ByteString -- ^ additional headers
-downloadToFile https host fullPath port destFile = do
+               -> Excepts '[DownloadFailed, HTTPNotModified] m Response
-  fd <- liftIO $ openFile destFile WriteMode
+downloadToFile https host fullPath port destFile addHeaders = do
-  let stepper = BS.hPut fd
+  let stepper = BS.appendFile destFile
-  flip finally (liftIO $ hClose fd)
+      setup = BS.writeFile destFile mempty
-    $ reThrowAll DownloadFailed $ downloadInternal True https host fullPath port stepper
+  catchAllE (\case
+              (V (HTTPStatusError i headers))
+                | i == 304
+                , Just e <- M.lookup (mk "etag") headers -> throwE $ HTTPNotModified (decUTF8Safe e)
+              v -> throwE $ DownloadFailed v
+            ) $ downloadInternal True https host fullPath port stepper setup addHeaders
 
 
 downloadInternal :: MonadIO m
@@ -92,6 +94,8 @@ downloadInternal :: MonadIO m
                  -> ByteString  -- ^ path with query
                  -> Maybe Int   -- ^ optional port
                  -> (ByteString -> IO a)   -- ^ the consuming step function
+                 -> IO a                   -- ^ setup action
+                 -> M.Map (CI ByteString) ByteString -- ^ additional headers
                  -> Excepts
                       '[ HTTPStatusError
                        , URIParseError
@@ -100,19 +104,21 @@ downloadInternal :: MonadIO m
                        , TooManyRedirs
                        ]
                       m
-                      ()
+                      Response
 downloadInternal = go (5 :: Int)
 
  where
-  go redirs progressBar https host path port consumer = do
+  go redirs progressBar https host path port consumer setup addHeaders = do
     r <- liftIO $ withConnection' https host port action
     veitherToExcepts r >>= \case
-      Just r' ->
+      Right r' ->
         if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
-      Nothing -> pure ()
+      Left res -> pure res
    where
     action c = do
-      let q = buildRequest1 $ http GET path
+      let q = buildRequest1 $ do
+                http GET path
+                flip M.traverseWithKey addHeaders $ \key val -> setHeader (original key) val
 
       sendRequest c q emptyBody
 
@@ -121,28 +127,30 @@ downloadInternal = go (5 :: Int)
         (\r i' -> runE $ do
           let scode = getStatusCode r
           if
-            | scode >= 200 && scode < 300 -> downloadStream r i' >> pure Nothing
+            | scode >= 200 && scode < 300 -> liftIO $ downloadStream r i' >> pure (Left r)
+            | scode == 304 -> throwE $ HTTPStatusError scode (getHeaderMap r)
             | scode >= 300 && scode < 400 -> case getHeader r "Location" of
-              Just r' -> pure $ Just r'
+              Just r' -> pure $ Right r'
               Nothing -> throwE NoLocationHeader
-            | otherwise -> throwE $ HTTPStatusError scode
+            | otherwise -> throwE $ HTTPStatusError scode (getHeaderMap r)
         )
 
     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
+        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  _       -> 0
               Right (r', _) -> r'
             Nothing -> 0
 
-      mpb <- if progressBar
+      (mpb :: Maybe (ProgressBar ())) <- if progressBar
-        then Just <$> liftIO (newProgressBar defStyle 10 (Progress 0 size ()))
+        then Just <$> newProgressBar defStyle 10 (Progress 0 size ())
         else pure Nothing
 
       outStream <- liftIO $ Streams.makeOutputStream
@@ -155,79 +163,6 @@ downloadInternal = go (5 :: Int)
       liftIO $ Streams.connect i' outStream
 
 
-getHead :: (MonadCatch m, MonadIO m)
-        => URI
-        -> Excepts
-             '[ HTTPStatusError
-              , URIParseError
-              , UnsupportedScheme
-              , NoLocationHeader
-              , TooManyRedirs
-              , ProcessError
-              ]
-             m
-             (M.Map (CI ByteString) ByteString)
-getHead uri' | scheme == "https" = head' True
-             | scheme == "http"  = head' False
-             | otherwise         = throwE UnsupportedScheme
-
- where
-  scheme = view (uriSchemeL' % schemeBSL') uri'
-  head' https = do
-    (_, host', fullPath', port') <- liftE $ uriToQuadruple uri'
-    liftE $ headInternal https host' fullPath' port'
-
-
-headInternal :: MonadIO m
-             => Bool        -- ^ https?
-             -> ByteString  -- ^ host
-             -> ByteString  -- ^ path with query
-             -> Maybe Int   -- ^ optional port
-             -> Excepts
-                  '[ HTTPStatusError
-                   , URIParseError
-                   , UnsupportedScheme
-                   , TooManyRedirs
-                   , NoLocationHeader
-                   ]
-                  m
-                  (M.Map (CI ByteString) ByteString)
-headInternal = go (5 :: Int)
-
- where
-  go redirs https host path port = do
-    r <- liftIO $ withConnection' https host port action
-    veitherToExcepts r >>= \case
-      Left r' ->
-        if redirs > 0 then followRedirectURL r' else throwE TooManyRedirs
-      Right hs -> pure hs
-   where
-
-    action c = do
-      let q = buildRequest1 $ http HEAD path
-
-      sendRequest c q emptyBody
-
-      unsafeReceiveResponse
-        c
-        (\r _ -> runE $ do
-          let scode = getStatusCode r
-          if
-            | scode >= 200 && scode < 300 -> do
-              let headers = getHeaderMap r
-              pure $ Right headers
-            | scode >= 300 && scode < 400 -> case getHeader r "Location" of
-              Just r' -> pure $ Left r'
-              Nothing -> throwE NoLocationHeader
-            | otherwise -> throwE $ HTTPStatusError scode
-        )
-
-    followRedirectURL bs = case parseURI strictURIParserOptions bs of
-      Right uri' -> do
-        (https', host', fullPath', port') <- liftE $ uriToQuadruple uri'
-        go (redirs - 1) https' host' fullPath' port'
-      Left e -> throwE e
-
 
 withConnection' :: Bool
                 -> ByteString

lib/GHCup/Errors.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE QuasiQuotes           #-}
 {-# LANGUAGE TypeOperators           #-}
 {-# LANGUAGE FlexibleInstances           #-}
 
@@ -21,13 +20,10 @@ module GHCup.Errors where
 
 import           GHCup.Types
 
-#if !defined(TAR)
 import           Codec.Archive
-#else
-import qualified Codec.Archive.Tar             as Tar
-#endif
 import           Control.Exception.Safe
-import           Data.String.Interpolate
+import           Data.ByteString                ( ByteString )
+import           Data.CaseInsensitive           ( CI )
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           Haskus.Utils.Variant
@@ -35,6 +31,9 @@ import           Text.PrettyPrint               hiding ( (<>) )
 import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           URI.ByteString
 
+import qualified Data.Map.Strict               as M
+import qualified Data.Text                     as T
+
 
 
     ------------------------
@@ -88,7 +87,7 @@ data UnknownArchive = UnknownArchive FilePath
 
 instance Pretty UnknownArchive where
   pPrint (UnknownArchive file) =
-    text [i|The archive format is unknown. We don't know how to extract the file "#{file}"|]
+    text $ "The archive format is unknown. We don't know how to extract the file " <> file
 
 -- | The scheme is not supported (such as ftp).
 data UnsupportedScheme = UnsupportedScheme
@@ -111,7 +110,7 @@ data TagNotFound = TagNotFound Tag Tool
 
 instance Pretty TagNotFound where
   pPrint (TagNotFound tag tool) =
-    text "Unable to find tag" <+> pPrint tag <+> text [i|of tool "#{tool}"|]
+    text "Unable to find tag" <+> pPrint tag <+> text "of tool" <+> pPrint tool
 
 -- | Unable to find the next version of a tool (the one after the currently
 -- set one).
@@ -120,7 +119,7 @@ data NextVerNotFound = NextVerNotFound Tool
 
 instance Pretty NextVerNotFound where
   pPrint (NextVerNotFound tool) =
-    text [i|Unable to find next (the one after the currently set one) version of tool "#{tool}"|]
+    text "Unable to find next (the one after the currently set one) version of tool" <+> pPrint tool
 
 -- | The tool (such as GHC) is already installed with that version.
 data AlreadyInstalled = AlreadyInstalled Tool Version
@@ -128,7 +127,14 @@ data AlreadyInstalled = AlreadyInstalled Tool Version
 
 instance Pretty AlreadyInstalled where
   pPrint (AlreadyInstalled tool ver') =
-    text [i|#{tool}-#{prettyShow ver'} is already installed|]
+    pPrint tool <+> text "-" <+> pPrint ver' <+> text "is already installed"
+
+-- | The Directory is supposed to be empty, but wasn't.
+data DirNotEmpty = DirNotEmpty {path :: FilePath}
+
+instance Pretty DirNotEmpty where
+  pPrint (DirNotEmpty path) = do
+    text $ "The directory was expected to be empty, but isn't: " <> path
 
 -- | The tool is not installed. Some operations rely on a tool
 -- to be installed (such as setting the current GHC version).
@@ -137,7 +143,7 @@ data NotInstalled = NotInstalled Tool GHCTargetVersion
 
 instance Pretty NotInstalled where
   pPrint (NotInstalled tool ver) =
-    text [i|The version "#{prettyShow ver}" of the tool "#{tool}" is not installed.|]
+    text "The version" <+> pPrint ver <+> text "of the tool" <+> pPrint tool <+> text "is not installed."
 
 -- | An executable was expected to be in PATH, but was not found.
 data NotFoundInPATH = NotFoundInPATH FilePath
@@ -145,7 +151,7 @@ data NotFoundInPATH = NotFoundInPATH FilePath
 
 instance Pretty NotFoundInPATH where
   pPrint (NotFoundInPATH exe) =
-    text [i|The exe "#{exe}" was not found in PATH.|]
+    text $ "The exe " <> exe <> " was not found in PATH."
 
 -- | JSON decoding failed.
 data JSONError = JSONDecodeError String
@@ -153,7 +159,7 @@ data JSONError = JSONDecodeError String
 
 instance Pretty JSONError where
   pPrint (JSONDecodeError err) =
-    text [i|JSON decoding failed with: #{err}|]
+    text $ "JSON decoding failed with: " <> err
 
 -- | A file that is supposed to exist does not exist
 -- (e.g. when we use file scheme to "download" something).
@@ -162,7 +168,17 @@ data FileDoesNotExistError = FileDoesNotExistError FilePath
 
 instance Pretty FileDoesNotExistError where
   pPrint (FileDoesNotExistError file) =
-    text [i|File "#{file}" does not exist.|]
+    text $ "File " <> file <> " does not exist."
+
+-- | The file already exists
+-- (e.g. when we use isolated installs with the same path).
+-- (e.g. This is done to prevent any overwriting)
+data FileAlreadyExistsError = FileAlreadyExistsError FilePath
+  deriving Show
+
+instance Pretty FileAlreadyExistsError where
+  pPrint (FileAlreadyExistsError file) =
+    text $ "File " <> file <> " Already exists."
 
 data TarDirDoesNotExist = TarDirDoesNotExist TarDir
   deriving Show
@@ -177,15 +193,31 @@ data DigestError = DigestError Text Text
 
 instance Pretty DigestError where
   pPrint (DigestError currentDigest expectedDigest) =
-    text [i|Digest error: expected "#{expectedDigest}", but got "#{currentDigest}"|]
+    text "Digest error: expected" <+> text (T.unpack expectedDigest) <+> text "but got" <+> pPrint currentDigest
 
 -- | Unexpected HTTP status.
-data HTTPStatusError = HTTPStatusError Int
+data HTTPStatusError = HTTPStatusError Int (M.Map (CI ByteString) ByteString)
   deriving Show
 
 instance Pretty HTTPStatusError where
-  pPrint (HTTPStatusError status) =
+  pPrint (HTTPStatusError status _) =
-    text [i|Unexpected HTTP status: #{status}|]
+    text "Unexpected HTTP status:" <+> pPrint status
+
+-- | Malformed headers.
+data MalformedHeaders = MalformedHeaders Text
+  deriving Show
+
+instance Pretty MalformedHeaders where
+  pPrint (MalformedHeaders h) =
+    text "Headers are malformed: " <+> pPrint h
+
+-- | Unexpected HTTP status.
+data HTTPNotModified = HTTPNotModified Text
+  deriving Show
+
+instance Pretty HTTPNotModified where
+  pPrint (HTTPNotModified etag) =
+    text "Remote resource not modifed, etag was:" <+> pPrint etag
 
 -- | The 'Location' header was expected during a 3xx redirect, but not found.
 data NoLocationHeader = NoLocationHeader
@@ -193,7 +225,7 @@ data NoLocationHeader = NoLocationHeader
 
 instance Pretty NoLocationHeader where
   pPrint NoLocationHeader =
-    text [i|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
@@ -201,7 +233,7 @@ data TooManyRedirs = TooManyRedirs
 
 instance Pretty TooManyRedirs where
   pPrint TooManyRedirs =
-    text [i|Too many redirections.|]
+    text "Too many redirections."
 
 -- | A patch could not be applied.
 data PatchFailed = PatchFailed
@@ -209,7 +241,7 @@ data PatchFailed = PatchFailed
 
 instance Pretty PatchFailed where
   pPrint PatchFailed =
-    text [i|A patch could not be applied.|]
+    text "A patch could not be applied."
 
 -- | The tool requirements could not be found.
 data NoToolRequirements = NoToolRequirements
@@ -217,35 +249,35 @@ data NoToolRequirements = NoToolRequirements
 
 instance Pretty NoToolRequirements where
   pPrint NoToolRequirements =
-    text [i|The Tool requirements could not be found.|]
+    text "The Tool requirements could not be found."
 
 data InvalidBuildConfig = InvalidBuildConfig Text
   deriving Show
 
 instance Pretty InvalidBuildConfig where
   pPrint (InvalidBuildConfig reason) =
-    text [i|The build config is invalid. Reason was: #{reason}|]
+    text "The build config is invalid. Reason was:" <+> pPrint reason
 
 data NoToolVersionSet = NoToolVersionSet Tool
   deriving Show
 
 instance Pretty NoToolVersionSet where
   pPrint (NoToolVersionSet tool) =
-    text [i|No version is set for tool "#{tool}".|]
+    text "No version is set for tool" <+> pPrint tool <+> text "."
 
 data NoNetwork = NoNetwork
   deriving Show
 
 instance Pretty NoNetwork where
   pPrint NoNetwork =
-    text [i|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 [i|Could not find Hadrian build files. Does this GHC version support Hadrian builds?|]
+    text "Could not find Hadrian build files. Does this GHC version support Hadrian builds?"
 
 
     -------------------------
@@ -267,17 +299,17 @@ data BuildFailed = forall es . (Pretty (V es), Show (V es)) => BuildFailed FileP
 
 instance Pretty BuildFailed where
   pPrint (BuildFailed path reason) =
-    text [i|BuildFailed failed in dir "#{path}": |] <> pPrint reason
+    text "BuildFailed failed in dir" <+> text (path <> ":") <+> pPrint reason
 
 deriving instance Show BuildFailed
 
 
 -- | Setting the current GHC version failed.
-data GHCupSetError = forall es . Show (V es) => GHCupSetError (V es)
+data GHCupSetError = forall es . (Show (V es), Pretty (V es)) => GHCupSetError (V es)
 
 instance Pretty GHCupSetError where
   pPrint (GHCupSetError reason) =
-    text [i|Setting the current GHC version failed: #{reason}|]
+    text "Setting the current GHC version failed:" <+> pPrint reason
 
 deriving instance Show GHCupSetError
 
@@ -293,7 +325,7 @@ data ParseError = ParseError String
 
 instance Pretty ParseError where
   pPrint (ParseError reason) =
-    text [i|Parsing failed: #{reason}|]
+    text "Parsing failed:" <+> pPrint reason
 
 instance Exception ParseError
 
@@ -303,10 +335,19 @@ data UnexpectedListLength = UnexpectedListLength String
 
 instance Pretty UnexpectedListLength where
   pPrint (UnexpectedListLength reason) =
-    text [i|List length unexpected: #{reason}|]
+    text "List length unexpected:" <+> pPrint reason
 
 instance Exception UnexpectedListLength
 
+data NoUrlBase = NoUrlBase Text
+  deriving Show
+
+instance Pretty NoUrlBase where
+  pPrint (NoUrlBase url) =
+    text "Couldn't get a base filename from url" <+> pPrint url
+
+instance Exception NoUrlBase
+
 
 
     ------------------------
@@ -328,23 +369,22 @@ instance
 
 instance Pretty URIParseError where
   pPrint (MalformedScheme reason) =
-    text [i|Failed to parse URI. Malformed scheme: #{reason}|]
+    text "Failed to parse URI. Malformed scheme:" <+> text (show reason)
   pPrint MalformedUserInfo =
-    text [i|Failed to parse URI. Malformed user info.|]
+    text "Failed to parse URI. Malformed user info."
   pPrint MalformedQuery =
-    text [i|Failed to parse URI. Malformed query.|]
+    text "Failed to parse URI. Malformed query."
   pPrint MalformedFragment =
-    text [i|Failed to parse URI. Malformed fragment.|]
+    text "Failed to parse URI. Malformed fragment."
   pPrint MalformedHost =
-    text [i|Failed to parse URI. Malformed host.|]
+    text "Failed to parse URI. Malformed host."
   pPrint MalformedPort =
-    text [i|Failed to parse URI. Malformed port.|]
+    text "Failed to parse URI. Malformed port."
   pPrint MalformedPath =
-    text [i|Failed to parse URI. Malformed path.|]
+    text "Failed to parse URI. Malformed path."
   pPrint (OtherError err) =
-    text [i|Failed to parse URI: #{err}|]
+    text "Failed to parse URI:" <+> pPrint err
 
-#if !defined(TAR)
 instance Pretty ArchiveResult where
   pPrint ArchiveFatal = text "Archive result: fatal"
   pPrint ArchiveFailed = text "Archive result: failed"
@@ -352,14 +392,6 @@ instance Pretty ArchiveResult where
   pPrint ArchiveRetry = text "Archive result: retry"
   pPrint ArchiveOk = text "Archive result: Ok"
   pPrint ArchiveEOF = text "Archive result: EOF"
-#else
+
-instance Pretty Tar.FormatError where
+instance Pretty T.Text where
-  pPrint Tar.TruncatedArchive = text "Truncated archive"
+  pPrint = text . T.unpack
-  pPrint Tar.ShortTrailer = text "Short trailer"
-  pPrint Tar.BadTrailer = text "Bad trailer"
-  pPrint Tar.TrailingJunk = text "Trailing junk"
-  pPrint Tar.ChecksumIncorrect = text "Checksum incorrect"
-  pPrint Tar.NotTarFormat = text "Not a tar format"
-  pPrint Tar.UnrecognisedTarFormat = text "Unrecognised tar format"
-  pPrint Tar.HeaderBadNumericEncoding = text "Header has bad numeric encoding"
-#endif

lib/GHCup/Platform.hs

@@ -33,7 +33,6 @@ import           Control.Monad.Reader
 import           Data.ByteString                ( ByteString )
 import           Data.Foldable
 import           Data.Maybe
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           Haskus.Utils.Variant.Excepts
@@ -108,7 +107,7 @@ getPlatform = do
       pure $ PlatformResult { _platform = FreeBSD, _distroVersion = ver }
     "mingw32" -> pure PlatformResult { _platform = Windows, _distroVersion = Nothing }
     what -> throwE $ NoCompatiblePlatform what
-  lift $ $(logDebug) [i|Identified Platform as: #{prettyShow pfr}|]
+  lift $ $(logDebug) $ "Identified Platform as: " <> T.pack (prettyShow pfr)
   pure pfr
  where
   getFreeBSDVersion = lift $ fmap _stdOut $ executeOut "freebsd-version" [] Nothing

lib/GHCup/Types.hs

@@ -115,6 +115,13 @@ data Tool = GHC
           | Stack
   deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
 
+instance Pretty Tool where
+  pPrint GHC = text "ghc"
+  pPrint Cabal = text "cabal"
+  pPrint GHCup = text "ghcup"
+  pPrint HLS = text "hls"
+  pPrint Stack = text "stack"
+
 instance NFData Tool
 
 data GlobalTool = ShimGen
@@ -220,6 +227,7 @@ data LinuxDistro = Debian
                  | RedHat
                  | Alpine
                  | AmazonLinux
+                 | Solus
                  -- rolling
                  | Gentoo
                  | Exherbo
@@ -239,6 +247,7 @@ distroToString CentOS = "centos"
 distroToString RedHat = "redhat"
 distroToString Alpine = "alpine"
 distroToString AmazonLinux = "amazon"
+distroToString Solus = "solus"
 distroToString Gentoo = "gentoo"
 distroToString Exherbo = "exherbo"
 distroToString UnknownLinux = "unknown"
@@ -304,6 +313,41 @@ data UserSettings = UserSettings
 defaultUserSettings :: UserSettings
 defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
+fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
+fromSettings Settings{..} Nothing =
+  UserSettings {
+      uCache = Just cache
+    , uNoVerify = Just noVerify
+    , uVerbose = Just verbose
+    , uKeepDirs = Just keepDirs
+    , uDownloader = Just downloader
+    , uNoNetwork = Just noNetwork
+    , uKeyBindings = Nothing
+    , uUrlSource = Just urlSource
+  }
+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 
+            , kShowAll      = Just bShowAllVersions
+            , kShowAllTools = Just bShowAllTools
+            }
+  in UserSettings {
+      uCache = Just cache
+    , uNoVerify = Just noVerify
+    , uVerbose = Just verbose
+    , uKeepDirs = Just keepDirs
+    , uDownloader = Just downloader
+    , uNoNetwork = Just noNetwork
+    , uKeyBindings = Just ukb
+    , uUrlSource = Just urlSource
+  }
+
 data UserKeyBindings = UserKeyBindings
   { kUp        :: Maybe Key
   , kDown      :: Maybe Key

lib/GHCup/Types/JSON.hs

@@ -316,3 +316,6 @@ deriveJSON 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
 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

@@ -39,9 +39,7 @@ import           GHCup.Utils.MegaParsec
 import           GHCup.Utils.Prelude
 import           GHCup.Utils.String.QQ
 
-#if !defined(TAR)
 import           Codec.Archive           hiding ( Directory )
-#endif
 import           Codec.Archive.Zip
 import           Control.Applicative
 import           Control.Exception.Safe
@@ -64,7 +62,6 @@ import           Data.List
 import           Data.List.Extra
 import           Data.List.NonEmpty             ( NonEmpty( (:|) ))
 import           Data.Maybe
-import           Data.String.Interpolate
 import           Data.Text                      ( Text )
 import           Data.Versions
 import           GHC.IO.Exception
@@ -83,9 +80,6 @@ import           Text.PrettyPrint.HughesPJClass hiding ( (<>) )
 import           Text.Regex.Posix
 import           URI.ByteString
 
-#if defined(TAR)
-import qualified Codec.Archive.Tar             as Tar
-#endif
 import qualified Codec.Compression.BZip        as BZip
 import qualified Codec.Compression.GZip        as GZip
 import qualified Codec.Compression.Lzma        as Lzma
@@ -135,7 +129,7 @@ rmMinorSymlinks tv@GHCTargetVersion{..} = do
   forM_ files $ \f -> do
     let f_xyz = f <> "-" <> T.unpack (prettyVer _tvVersion) <> exeExt
     let fullF = binDir </> f_xyz
-    lift $ $(logDebug) [i|rm -f #{fullF}|]
+    lift $ $(logDebug) ("rm -f " <> T.pack fullF)
     lift $ hideError doesNotExistErrorType $ rmLink fullF
 
 
@@ -157,11 +151,11 @@ rmPlain target = do
     files <- liftE $ ghcToolFiles tv
     forM_ files $ \f -> do
       let fullF = binDir </> f <> exeExt
-      lift $ $(logDebug) [i|rm -f #{fullF}|]
+      lift $ $(logDebug) ("rm -f " <> T.pack fullF)
       lift $ hideError doesNotExistErrorType $ rmLink fullF
     -- old ghcup
     let hdc_file = binDir </> "haddock-ghc" <> exeExt
-    lift $ $(logDebug) [i|rm -f #{hdc_file}|]
+    lift $ $(logDebug) ("rm -f " <> T.pack hdc_file)
     lift $ hideError doesNotExistErrorType $ rmLink hdc_file
 
 
@@ -185,7 +179,7 @@ rmMajorSymlinks tv@GHCTargetVersion{..} = do
   forM_ files $ \f -> do
     let f_xy = f <> "-" <> T.unpack v' <> exeExt
     let fullF = binDir </> f_xy
-    lift $ $(logDebug) [i|rm -f #{fullF}|]
+    lift $ $(logDebug) "rm -f #{fullF}"
     lift $ hideError doesNotExistErrorType $ rmLink fullF
 
 
@@ -301,7 +295,11 @@ cabalSet = do
         case linkVersion =<< link of
           Right v -> pure $ Just v
           Left err -> do
-            $(logWarn) [i|Failed to parse cabal symlink target with: "#{err}". The symlink #{cabalbin} needs to point to valid cabal binary, such as 'cabal-3.4.0.0'.|]
+            $(logWarn) $ "Failed to parse cabal symlink target with: "
+              <> T.pack (displayException err)
+              <> ". The symlink "
+              <> T.pack cabalbin
+              <> " needs to point to valid cabal binary, such as 'cabal-3.4.0.0'."
             pure Nothing
  where
   -- We try to be extra permissive with link destination parsing,
@@ -385,7 +383,11 @@ stackSet = do
         case linkVersion =<< link of
           Right v -> pure $ Just v
           Left err -> do
-            $(logWarn) [i|Failed to parse stack symlink target with: "#{err}". The symlink #{stackBin} needs to point to valid stack binary, such as 'stack-2.7.1'.|]
+            $(logWarn) $ "Failed to parse stack symlink target with: "
+              <> T.pack (displayException err)
+              <> ". The symlink "
+              <> T.pack stackBin
+              <> " needs to point to valid stack binary, such as 'stack-2.7.1'."
             pure Nothing
  where
   linkVersion :: MonadThrow m => FilePath -> m Version
@@ -603,27 +605,17 @@ unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
             => FilePath       -- ^ destination dir
             -> FilePath       -- ^ archive path
             -> Excepts '[UnknownArchive
-#if !defined(TAR)
                         , ArchiveResult
-#endif
                         ] m ()
 unpackToDir dfp av = do
   let fn = takeFileName av
-  lift $ $(logInfo) [i|Unpacking: #{fn} to #{dfp}|]
+  lift $ $(logInfo) $ "Unpacking: " <> T.pack fn <> " to " <> T.pack dfp
 
-#if defined(TAR)
-  let untar :: MonadIO m => BL.ByteString -> Excepts '[] m ()
-      untar = liftIO . Tar.unpack dfp . Tar.read
-
-      rf :: MonadIO m => FilePath -> Excepts '[] m BL.ByteString
-      rf = liftIO . BL.readFile
-#else
   let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
       untar = lEM . liftIO . runArchiveM . unpackToDirLazy dfp
 
       rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
       rf = liftIO . BL.readFile
-#endif
 
   -- extract, depending on file extension
   if
@@ -644,34 +636,16 @@ unpackToDir dfp av = do
 getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m)
                 => FilePath       -- ^ archive path
                 -> Excepts '[UnknownArchive
-#if defined(TAR)
-                            , Tar.FormatError
-#else
                             , ArchiveResult
-#endif
                             ] m [FilePath]
 getArchiveFiles av = do
   let fn = takeFileName av
 
-#if defined(TAR)
-  let entries :: Monad m => BL.ByteString -> Excepts '[Tar.FormatError] m [FilePath]
-      entries =
-          lE @Tar.FormatError
-          . Tar.foldEntries
-            (\e x -> fmap (Tar.entryPath e :) x)
-            (Right [])
-            (\e -> Left e)
-          . Tar.read
-
-      rf :: MonadIO m => FilePath -> Excepts '[Tar.FormatError] m BL.ByteString
-      rf = liftIO . BL.readFile
-#else
   let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
       entries = (fmap . fmap) filepath . lE . readArchiveBSL
 
       rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
       rf = liftIO . BL.readFile
-#endif
 
   -- extract, depending on file extension
   if
@@ -766,49 +740,22 @@ ghcToolFiles ver = do
   whenM (fmap not $ liftIO $ doesDirectoryExist ghcdir)
         (throwE (NotInstalled GHC ver))
 
-  files    <- liftIO $ listDirectory bindir
+  files <- liftIO (listDirectory bindir >>= filterM (doesFileExist . (bindir </>)))
-  -- figure out the <ver> suffix, because this might not be `Version` for
+  pure (getUniqueTools . groupToolFiles . fmap (dropSuffix exeExt) $ files)
-  -- alpha/rc releases, but x.y.a.somedate.
 
-  ghcIsHadrian    <- liftIO $ isHadrian bindir
-  onlyUnversioned <- case ghcIsHadrian of
-    Right () -> pure id
-    Left (fmap (dropSuffix exeExt) -> [ghc, ghc_ver])
-      | (Just symver) <- stripPrefix (ghc <> "-") ghc_ver
-      , not (null symver) -> pure $ filter (\x -> not $ symver `isInfixOf` x)
-    _ -> fail "Fatal: Could not find internal GHC version"
-
-  pure $ onlyUnversioned $ fmap (dropSuffix exeExt) files
  where
-  isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
-    -- GHC is moving some builds to Hadrian for bindists,
-    -- which doesn't create versioned binaries.
-    -- https://gitlab.haskell.org/haskell/ghcup-hs/issues/31
-  isHadrian :: FilePath -- ^ ghcbin path
-            -> IO (Either [String] ()) -- ^ Right for Hadrian
-  isHadrian dir = do
-    -- Non-hadrian has e.g. ["ghc", "ghc-8.10.4"]
-    -- which also requires us to discover the internal version
-    -- to filter the correct tool files.
-    -- We can't use the symlink on windows, so we fall back to some
-    -- more complicated logic.
-    fs <- fmap
-         -- regex over-matches
-         (filter (isNotAnyInfix ["haddock", "ghc-pkg", "ghci"]))
-       $ liftIO $ findFiles
-      dir
-      (makeRegexOpts compExtended
-                     execBlank
-                     -- for cross, this won't be "ghc", but e.g.
-                     -- "armv7-unknown-linux-gnueabihf-ghc"
-                     ([s|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc.*$|] :: ByteString)
-      )
-    if | length fs == 1 -> pure $ Right ()        -- hadrian
-       | length fs == 2 -> pure $ Left
-                              (sortOn length fs)  -- legacy make, result should
-                                                  -- be ["ghc", "ghc-8.10.4"]
-       | otherwise      -> fail "isHadrian failed!"
 
+  groupToolFiles :: [FilePath] -> [[(FilePath, String)]]
+  groupToolFiles = groupBy (\(a, _) (b, _) -> a == b) . fmap (splitOnPVP "-")
+
+  getUniqueTools :: [[(FilePath, String)]] -> [String]
+  getUniqueTools = filter (isNotAnyInfix blackListedTools) . nub . fmap fst . filter ((== "") . snd) . concat
+
+  blackListedTools :: [String]
+  blackListedTools = ["haddock-ghc"]
+
+  isNotAnyInfix :: [String] -> String -> Bool
+  isNotAnyInfix xs t = foldr (\a b -> not (a `isInfixOf` t) && b) True xs
 
 
 -- | This file, when residing in @~\/.ghcup\/ghc\/\<ver\>\/@ signals that
@@ -853,7 +800,7 @@ applyPatches :: (MonadReader env m, HasDirs env, MonadLogger m, MonadIO m)
 applyPatches pdir ddir = do
   patches <- (fmap . fmap) (pdir </>) $ liftIO $ listDirectory pdir
   forM_ (sort patches) $ \patch' -> do
-    lift $ $(logInfo) [i|Applying patch #{patch'}|]
+    lift $ $(logInfo) $ "Applying patch " <> T.pack patch'
     fmap (either (const Nothing) Just)
          (exec
            "patch"
@@ -924,8 +871,8 @@ runBuildAction bdir instdir action = do
 -- printing other errors without crashing.
 rmBDir :: (MonadLogger m, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
 rmBDir dir = withRunInIO (\run -> run $
-           liftIO $ handleIO (\e -> run $ $(logWarn)
+           liftIO $ handleIO (\e -> run $ $(logWarn) $
-               [i|Couldn't remove build dir #{dir}, error was: #{displayException e}|])
+               "Couldn't remove build dir " <> T.pack dir <> ", error was: " <> T.pack (displayException e))
            $ hideError doesNotExistErrorType
            $ rmPathForcibly dir)
 
@@ -1059,17 +1006,17 @@ createLink link exe = do
       fullLink = takeDirectory exe </> link
       shimContents = "path = " <> fullLink
 
-  $(logDebug) [i|rm -f #{exe}|]
+  $(logDebug) $ "rm -f " <> T.pack exe
   rmLink exe
 
-  $(logDebug) [i|ln -s #{fullLink} #{exe}|]
+  $(logDebug) $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
   liftIO $ copyFile shimGen exe
   liftIO $ writeFile shim shimContents
 #else
-  $(logDebug) [i|rm -f #{exe}|]
+  $(logDebug) $ "rm -f " <> T.pack exe
   hideError doesNotExistErrorType $ recycleFile exe
 
-  $(logDebug) [i|ln -s #{link} #{exe}|]
+  $(logDebug) $ "ln -s " <> T.pack link <> " " <> T.pack exe
   liftIO $ createFileLink link exe
 #endif
 
@@ -1094,8 +1041,8 @@ ensureGlobalTools = do
     $ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
   let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
   void $ (\(DigestError _ _) -> do
-      lift $ $(logWarn) [i|Digest doesn't match, redownloading gs.exe...|]
+      lift $ $(logWarn) "Digest doesn't match, redownloading gs.exe..."
-      lift $ $(logDebug) [i|rm -f #{shimDownload}|]
+      lift $ $(logDebug) "rm -f #{shimDownload}"
       lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
       liftE @'[DigestError , DownloadFailed] $ dl
     ) `catchE` (liftE @'[DigestError , DownloadFailed] dl)

lib/GHCup/Utils/Dirs.hs

@@ -50,7 +50,6 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource hiding (throwM)
 import           Data.Bifunctor
 import           Data.Maybe
-import           Data.String.Interpolate
 import           GHC.IO.Exception               ( IOErrorType(NoSuchThing) )
 import           Haskus.Utils.Variant.Excepts
 import           Optics
@@ -274,7 +273,13 @@ mkGhcupTmpDir = do
   let minSpace = 5000 -- a rough guess, aight?
   space <- handleIO (\_ -> pure Nothing) $ fmap Just $ liftIO $ getAvailSpace tmpdir
   when (maybe False (toBytes minSpace >) space) $ do
-    $(logWarn) [i|Possibly insufficient disk space on #{tmpdir}. At least #{minSpace} MB are recommended, but only #{toMB (fromJust space)} are free. Consider freeing up disk space or setting TMPDIR env variable.|]
+    $(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
@@ -282,7 +287,7 @@ mkGhcupTmpDir = do
   liftIO $ createTempDirectory tmpdir "ghcup"
  where
   toBytes mb = mb * 1024 * 1024
-  toMB b = show (truncate' (fromIntegral b / (1024 * 1024) :: Double) 2)
+  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
@@ -304,7 +309,7 @@ withGHCupTmpDir = snd <$> withRunInIO (\run ->
         (run mkGhcupTmpDir)
         (\fp ->
             handleIO (\e -> run
-                $ $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|])
+                $ $(logDebug) ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e)))
             . rmPathForcibly
             $ fp))
 
@@ -347,8 +352,8 @@ cleanupTrash = do
   if null contents
   then pure ()
   else do
-    $(logWarn) [i|Removing leftover files in #{recycleDir}|]
+    $(logWarn) ("Removing leftover files in " <> T.pack recycleDir)
     forM_ contents (\fp -> handleIO (\e ->
-        $(logDebug) [i|Resource cleanup failed for "#{fp}", error was: #{displayException e}|]
+        $(logDebug) ("Resource cleanup failed for " <> T.pack fp <> ", error was: " <> T.pack (displayException e))
       ) $ liftIO $ removePathForcibly (recycleDir </> fp))
 

lib/GHCup/Utils/File/Common.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE QuasiQuotes       #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE TemplateHaskell   #-}
@@ -11,7 +10,6 @@ import           GHCup.Utils.Prelude
 import           Control.Monad.Extra
 import           Control.Monad.Reader
 import           Data.Maybe
-import           Data.String.Interpolate
 import           GHC.IO.Exception
 import           Optics                  hiding ((<|), (|>))
 import           System.Directory
@@ -31,13 +29,13 @@ data ProcessError = NonZeroExit Int FilePath [String]
 
 instance Pretty ProcessError where
   pPrint (NonZeroExit e exe args) =
-    text [i|Process "#{exe}" with arguments #{args} failed with exit code #{e}.|]
+    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " failed with exit code " <+> text (show e) <+> "."
   pPrint (PTerminated exe args) =
-    text [i|Process "#{exe}" with arguments #{args} terminated.|]
+    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " terminated."
   pPrint (PStopped exe args) =
-    text [i|Process "#{exe}" with arguments #{args} stopped.|]
+    text "Process " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text " stopped."
   pPrint (NoSuchPid exe args) =
-    text [i|Could not find PID for process running "#{exe}" with arguments #{args}.|]
+    text "Could not find PID for process running " <+> pPrint exe <+> text " with arguments " <+> text (show args) <+> text "."
 
 data CapturedProcess = CapturedProcess
   { _exitCode :: ExitCode

lib/GHCup/Utils/File/Posix.hs

@@ -35,7 +35,6 @@ import           Data.ByteString                ( ByteString )
 import           Data.Foldable
 import           Data.IORef
 import           Data.Sequence                  ( Seq, (|>) )
-import           Data.String.Interpolate
 import           Data.List
 import           Data.Word8
 import           GHC.IO.Exception
@@ -362,7 +361,7 @@ chmod_755 fp = do
             `unionFileModes` groupReadMode
             `unionFileModes` otherExecuteMode
             `unionFileModes` otherReadMode
-  $(logDebug) [i|chmod 755 #{fp}|]
+  $(logDebug) ("chmod 755 " <> T.pack fp)
   liftIO $ setFileMode fp exe_mode
 
 

lib/GHCup/Utils/File/Windows.hs

@@ -209,6 +209,20 @@ exec exe args chdir env = do
   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
+
+
 chmod_755 :: MonadIO m => FilePath -> m ()
 chmod_755 fp =
   let perm = setOwnerWritable True emptyPermissions

lib/GHCup/Utils/Prelude.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
+{-# LANGUAGE TemplateHaskell     #-}
 
 {-|
 Module      : GHCup.Utils.Prelude
@@ -29,9 +30,10 @@ import           Control.Exception.Safe
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
+import           Control.Monad.Logger
 import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
-import           Data.List                      ( nub )
+import           Data.List                      ( nub, intercalate )
 import           Data.Foldable
 import           Data.String
 import           Data.Text                      ( Text )
@@ -39,6 +41,7 @@ import           Data.Versions
 import           Data.Word8
 import           Haskus.Utils.Types.List
 import           Haskus.Utils.Variant.Excepts
+import           Text.PrettyPrint.HughesPJClass ( prettyShow, Pretty )
 import           System.IO.Error
 #if defined(IS_WINDOWS)
 import           System.IO.Temp
@@ -55,6 +58,7 @@ import           GHC.IO.Exception
 import qualified Data.ByteString               as B
 import qualified Data.ByteString.Lazy          as L
 import qualified Data.Strict.Maybe             as S
+import qualified Data.List.Split               as Split
 import qualified Data.Text                     as T
 import qualified Data.Text.Encoding            as E
 import qualified Data.Text.Encoding.Error      as E
@@ -67,6 +71,14 @@ import qualified System.Win32.File             as Win32
 #endif
 
 
+-- $setup
+-- >>> import Data.ByteString.Internal (c2w, w2c)
+-- >>> import Test.QuickCheck
+-- >>> import Data.Word8
+-- >>> import Data.Word8
+-- >>> import qualified Data.Text as T
+-- >>> instance Arbitrary T.Text where arbitrary = T.pack <$> arbitrary
+
 
 fS :: IsString a => String -> a
 fS = fromString
@@ -161,6 +173,10 @@ lEM' :: forall e' e es a m
      -> Excepts es m a
 lEM' f em = lift em >>= lE . first f
 
+-- for some obscure reason... this won't type-check if we move it to a different module
+catchWarn :: forall es m . (Pretty (V es), MonadLogger m, Monad m) => Excepts es m () -> Excepts '[] m ()
+catchWarn = catchAllE @_ @es (\v -> lift $ $(logWarn) (T.pack . prettyShow $ v))
+
 fromEither :: Either a b -> VEither '[a] b
 fromEither = either (VLeft . V) VRight
 
@@ -410,12 +426,7 @@ rmPathForcibly :: ( MonadIO m
                -> m ()
 rmPathForcibly fp =
 #if defined(IS_WINDOWS)
-  recovering (fullJitterBackoff 25000 <> limitRetries 10)
+  recover (liftIO $ removePathForcibly fp)
-    [\_ -> Handler (\e -> pure $ isPermissionError e)
-    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
-    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
-    ]
-    (\_ -> liftIO $ removePathForcibly fp)
 #else
   liftIO $ removePathForcibly fp
 #endif
@@ -426,12 +437,7 @@ rmDirectory :: (MonadIO m, MonadMask m)
             -> m ()
 rmDirectory fp =
 #if defined(IS_WINDOWS)
-  recovering (fullJitterBackoff 25000 <> limitRetries 10)
+  recover (liftIO $ removeDirectory fp)
-    [\_ -> Handler (\e -> pure $ isPermissionError e)
-    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
-    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
-    ]
-    (\_ -> liftIO $ removeDirectory fp)
 #else
   liftIO $ removeDirectory fp
 #endif
@@ -469,12 +475,7 @@ rmFile :: ( MonadIO m
       -> m ()
 rmFile fp =
 #if defined(IS_WINDOWS)
-  recovering (fullJitterBackoff 25000 <> limitRetries 10)
+  recover (liftIO $ removeFile fp)
-    [\_ -> Handler (\e -> pure $ isPermissionError e)
-    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
-    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
-    ]
-    (\_ -> liftIO $ removeFile fp)
 #else
   liftIO $ removeFile fp
 #endif
@@ -485,12 +486,7 @@ rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env)
                 -> m ()
 rmDirectoryLink fp = 
 #if defined(IS_WINDOWS)
-  recovering (fullJitterBackoff 25000 <> limitRetries 10)
+  recover (liftIO $ removeDirectoryLink fp)
-    [\_ -> Handler (\e -> pure $ isPermissionError e)
-    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == InappropriateType))
-    ,\_ -> Handler (\e -> pure (ioeGetErrorType e == UnsatisfiedConstraints))
-    ]
-    (\_ -> liftIO $ removeDirectoryLink fp)
 #else
   liftIO $ removeDirectoryLink fp
 #endif
@@ -508,7 +504,14 @@ recover action =
 #endif
 
 
--- Gathering monoidal values
+-- | Gathering monoidal values
+--
+-- >>> traverseFold (pure . (:["0"])) ["1","2"]
+-- ["1","0","2","0"]
+-- >>> traverseFold Just ["1","2","3","4","5"]
+-- Just "12345"
+--
+-- prop> \t -> traverseFold Just t === Just (mconcat t)
 traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
 traverseFold f = foldl (\mb a -> (<>) <$> mb <*> f a) (pure mempty)
 
@@ -518,6 +521,16 @@ forFold = \t -> (`traverseFold` t)
 
 
 -- | Strip @\\r@ and @\\n@ from 'ByteString's
+--
+-- >>> stripNewline "foo\n\n\n"
+-- "foo"
+-- >>> stripNewline "foo\r"
+-- "foo"
+-- >>> stripNewline "foo"
+-- "foo"
+--
+-- prop> \t -> stripNewline (t <> "\n") === stripNewline t
+-- prop> \t -> not (any (isNewLine . c2w) t) ==> stripNewline t == t
 stripNewline :: String -> String
 stripNewline s
   | null s               = []
@@ -525,8 +538,52 @@ stripNewline s
   | otherwise            = head s : stripNewline (tail s)
 
 
+-- | Strip @\\r@ and @\\n@ from 'ByteString's
+--
+-- >>> stripNewline' "foo\n\n\n"
+-- "foo"
+-- >>> stripNewline' "foo\r"
+-- "foo"
+-- >>> stripNewline' "foo"
+-- "foo"
+--
+-- prop> \t -> stripNewline' (t <> "\n") === stripNewline' t
+-- prop> \t -> not (T.any (isNewLine . c2w) t) ==> stripNewline' t == t
+stripNewline' :: T.Text -> T.Text
+stripNewline' s
+  | T.null s               = mempty
+  | T.head s `elem` "\n\r" = stripNewline' (T.tail s)
+  | otherwise              = T.singleton (T.head s) <> stripNewline' (T.tail s)
+
+
+-- | Is the word8 a newline?
+--
+-- >>> isNewLine (c2w '\n')
+-- True
+-- >>> isNewLine (c2w '\r')
+-- True
+--
+-- prop> \w -> w /= _lf && w /= _cr ==> not (isNewLine w)
 isNewLine :: Word8 -> Bool
 isNewLine w
   | w == _lf = True
   | w == _cr = True
   | otherwise = False
+
+
+-- | Split on a PVP suffix.
+--
+-- >>> splitOnPVP "-" "ghc-iserv-dyn-9.3.20210706"
+-- ("ghc-iserv-dyn","9.3.20210706")
+-- >>> splitOnPVP "-" "ghc-iserv-dyn"
+-- ("ghc-iserv-dyn","")
+splitOnPVP :: String -> String -> (String, String)
+splitOnPVP c s = case Split.splitOn c s of
+  []  -> def
+  [_] -> def
+  xs
+    | let l = last xs
+    , (Right _) <- pvp (T.pack l) -> (intercalate c (init xs), l)
+    | otherwise -> def
+ where
+  def = (s, "")

lib/GHCup/Version.hs

@@ -25,7 +25,7 @@ import qualified Data.Text                     as T
 
 -- | This reflects the API version of the YAML.
 ghcupURL :: URI
-ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.5.yaml|]
+ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.7.yaml|]
 
 -- | The current ghcup version.
 ghcUpVer :: PVP

stack.yaml

@@ -1,18 +1,15 @@
-resolver: lts-18.2
+resolver: lts-18.7
 
 packages:
   - .
 
 extra-deps:
-  - git: https://github.com/hasufell/text-conversions.git
+  - git: https://github.com/bgamari/terminal-size
-    commit: 9abf0e5e5664a3178367597c32db19880477a53c
+    commit: 34ea816bd63f75f800eedac12c6908c6f3736036
-
+  - git: https://github.com/hasufell/libarchive
-  - git: https://github.com/Bodigrim/tar
+    commit: 024a7e8ab7b4d3848dc64dca1e70a04831eedc99
-    commit: ac197ec7ea4838dc2b4e22b9b888b080cedf29cf
-
-  - git: https://github.com/jtdaugherty/brick.git
-    commit: b3b96cfe66dfd398d338e3feb2b6855e66a35190
 
+  - brick-0.64@sha256:f03fa14607c22cf48af99e24c44f79a0fb073f7ec229f15e969fed9ff73c93f6,16530
   - IfElse-0.85@sha256:6939b94acc6a55f545f63a168a349dd2fbe4b9a7cca73bf60282db5cc6aa47d2,445
   - ascii-string-1.0.1.4@sha256:fa34f1d9ba57e8e89c0d4c9cef5e01ba32cb2d4373d13f92dcc0b531a6c6749b,2582
   - base16-bytestring-0.1.1.7@sha256:0021256a9628971c08da95cb8f4d0d72192f3bb8a7b30b55c080562d17c43dd3,2231
@@ -31,7 +28,6 @@ extra-deps:
   - hspec-discover-2.7.10@sha256:d08bf5dd785629f589571477d9beb7cd91529471bd89f39517c1cb4b9b38160f,2184
   - hspec-golden-aeson-0.9.0.0@sha256:aa17274114026661ba4dfc9c60c230673c8f408bd86482fd611d2d5cb6aff996,2179
   - http-io-streams-0.1.6.0@sha256:53f5bab177efb52cd65ec396fd04ed59b93e5f919fb3700cd7dacd6cfce6f06d,3582
-  - libarchive-3.0.2.1@sha256:40ebf2a278e585802427bc58826867208bb33822f63d56107a1fcc3ca04d691d,10990
   - lzma-static-5.2.5.3@sha256:2758ee58c35992fcf7db78e98684c357a16a82fa2a4e7c352a6c210c08c555d8,7308
   - os-release-1.0.1@sha256:1281c62081f438fc3f0874d3bae6a4887d5964ac25261ba06e29d368ab173467,2716
   - optics-0.4@sha256:9fb69bf0195b8d8f1f8cd0098000946868b8a3c3ffb51e5b64f79fc600c3eb4c,6568

www/Discord-Logo-Black.svg

@@ -0,0 +1,10 @@
+<svg width="71" height="55" viewBox="0 0 71 55" fill="none" xmlns="http://www.w3.org/2000/svg">
+<g clip-path="url(#clip0)">
+<path d="M60.1045 4.8978C55.5792 2.8214 50.7265 1.2916 45.6527 0.41542C45.5603 0.39851 45.468 0.440769 45.4204 0.525289C44.7963 1.6353 44.105 3.0834 43.6209 4.2216C38.1637 3.4046 32.7345 3.4046 27.3892 4.2216C26.905 3.0581 26.1886 1.6353 25.5617 0.525289C25.5141 0.443589 25.4218 0.40133 25.3294 0.41542C20.2584 1.2888 15.4057 2.8186 10.8776 4.8978C10.8384 4.9147 10.8048 4.9429 10.7825 4.9795C1.57795 18.7309 -0.943561 32.1443 0.293408 45.3914C0.299005 45.4562 0.335386 45.5182 0.385761 45.5576C6.45866 50.0174 12.3413 52.7249 18.1147 54.5195C18.2071 54.5477 18.305 54.5139 18.3638 54.4378C19.7295 52.5728 20.9469 50.6063 21.9907 48.5383C22.0523 48.4172 21.9935 48.2735 21.8676 48.2256C19.9366 47.4931 18.0979 46.6 16.3292 45.5858C16.1893 45.5041 16.1781 45.304 16.3068 45.2082C16.679 44.9293 17.0513 44.6391 17.4067 44.3461C17.471 44.2926 17.5606 44.2813 17.6362 44.3151C29.2558 49.6202 41.8354 49.6202 53.3179 44.3151C53.3935 44.2785 53.4831 44.2898 53.5502 44.3433C53.9057 44.6363 54.2779 44.9293 54.6529 45.2082C54.7816 45.304 54.7732 45.5041 54.6333 45.5858C52.8646 46.6197 51.0259 47.4931 49.0921 48.2228C48.9662 48.2707 48.9102 48.4172 48.9718 48.5383C50.038 50.6034 51.2554 52.5699 52.5959 54.435C52.6519 54.5139 52.7526 54.5477 52.845 54.5195C58.6464 52.7249 64.529 50.0174 70.6019 45.5576C70.6551 45.5182 70.6887 45.459 70.6943 45.3942C72.1747 30.0791 68.2147 16.7757 60.1968 4.9823C60.1772 4.9429 60.1437 4.9147 60.1045 4.8978ZM23.7259 37.3253C20.2276 37.3253 17.3451 34.1136 17.3451 30.1693C17.3451 26.225 20.1717 23.0133 23.7259 23.0133C27.308 23.0133 30.1626 26.2532 30.1066 30.1693C30.1066 34.1136 27.28 37.3253 23.7259 37.3253ZM47.3178 37.3253C43.8196 37.3253 40.9371 34.1136 40.9371 30.1693C40.9371 26.225 43.7636 23.0133 47.3178 23.0133C50.9 23.0133 53.7545 26.2532 53.6986 30.1693C53.6986 34.1136 50.9 37.3253 47.3178 37.3253Z" fill="#23272A"/>
+</g>
+<defs>
+<clipPath id="clip0">
+<rect width="71" height="55" fill="white"/>
+</clipPath>
+</defs>
+</svg>

www/Matrix_logo.svg

@@ -0,0 +1,7 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<svg version="1.1" viewBox="0 0 75 32" xmlns="http://www.w3.org/2000/svg" xmlns:cc="http://creativecommons.org/ns#" xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">
+<title>Matrix (protocol) logo</title>
+ <g fill="#040404">
+  <path d="m0.936 0.732v30.52h2.194v0.732h-3.035v-31.98h3.034v0.732zm8.45 9.675v1.544h0.044a4.461 4.461 0 0 1 1.487-1.368c0.58-0.323 1.245-0.485 1.993-0.485 0.72 0 1.377 0.14 1.972 0.42 0.595 0.279 1.047 0.771 1.355 1.477 0.338-0.5 0.796-0.941 1.377-1.323 0.58-0.383 1.266-0.574 2.06-0.574 0.602 0 1.16 0.074 1.674 0.22 0.514 0.148 0.954 0.383 1.322 0.707 0.366 0.323 0.653 0.746 0.859 1.268 0.205 0.522 0.308 1.15 0.308 1.887v7.633h-3.127v-6.464c0-0.383-0.015-0.743-0.044-1.082a2.305 2.305 0 0 0-0.242-0.882 1.473 1.473 0 0 0-0.584-0.596c-0.257-0.146-0.606-0.22-1.047-0.22-0.44 0-0.796 0.085-1.068 0.253-0.272 0.17-0.485 0.39-0.639 0.662a2.654 2.654 0 0 0-0.308 0.927 7.074 7.074 0 0 0-0.078 1.048v6.354h-3.128v-6.398c0-0.338-7e-3 -0.673-0.021-1.004a2.825 2.825 0 0 0-0.188-0.916 1.411 1.411 0 0 0-0.55-0.673c-0.258-0.168-0.636-0.253-1.135-0.253a2.33 2.33 0 0 0-0.584 0.1 1.94 1.94 0 0 0-0.705 0.374c-0.228 0.184-0.422 0.449-0.584 0.794-0.161 0.346-0.242 0.798-0.242 1.357v6.619h-3.129v-11.41zm16.46 1.677a3.751 3.751 0 0 1 1.233-1.17 5.37 5.37 0 0 1 1.685-0.629 9.579 9.579 0 0 1 1.884-0.187c0.573 0 1.153 0.04 1.74 0.121 0.588 0.081 1.124 0.24 1.609 0.475 0.484 0.235 0.88 0.562 1.19 0.981 0.308 0.42 0.462 0.975 0.462 1.666v5.934c0 0.516 0.03 1.008 0.088 1.478 0.058 0.471 0.161 0.824 0.308 1.06h-3.171a4.435 4.435 0 0 1-0.22-1.104c-0.5 0.515-1.087 0.876-1.762 1.081a7.084 7.084 0 0 1-2.071 0.31c-0.544 0-1.05-0.067-1.52-0.2a3.472 3.472 0 0 1-1.234-0.617 2.87 2.87 0 0 1-0.826-1.059c-0.199-0.426-0.298-0.934-0.298-1.522 0-0.647 0.114-1.18 0.342-1.6 0.227-0.419 0.52-0.753 0.881-1.004 0.36-0.25 0.771-0.437 1.234-0.562 0.462-0.125 0.929-0.224 1.399-0.298 0.47-0.073 0.932-0.132 1.387-0.176 0.456-0.044 0.86-0.11 1.212-0.199 0.353-0.088 0.631-0.217 0.837-0.386s0.301-0.415 0.287-0.74c0-0.337-0.055-0.606-0.166-0.804a1.217 1.217 0 0 0-0.44-0.464 1.737 1.737 0 0 0-0.639-0.22 5.292 5.292 0 0 0-0.782-0.055c-0.617 0-1.101 0.132-1.454 0.397-0.352 0.264-0.558 0.706-0.617 1.323h-3.128c0.044-0.735 0.227-1.345 0.55-1.83zm6.179 4.423a5.095 5.095 0 0 1-0.639 0.165 9.68 9.68 0 0 1-0.716 0.11c-0.25 0.03-0.5 0.067-0.749 0.11a5.616 5.616 0 0 0-0.694 0.177 2.057 2.057 0 0 0-0.594 0.298c-0.17 0.125-0.305 0.284-0.408 0.474-0.103 0.192-0.154 0.434-0.154 0.728 0 0.28 0.051 0.515 0.154 0.706 0.103 0.192 0.242 0.342 0.419 0.453 0.176 0.11 0.381 0.187 0.617 0.231 0.234 0.044 0.477 0.066 0.726 0.066 0.617 0 1.094-0.102 1.432-0.309 0.338-0.205 0.587-0.452 0.75-0.739 0.16-0.286 0.26-0.576 0.297-0.87 0.036-0.295 0.055-0.53 0.055-0.707v-1.17a1.4 1.4 0 0 1-0.496 0.277zm11.86-6.1v2.096h-2.291v5.647c0 0.53 0.088 0.883 0.264 1.059 0.176 0.177 0.529 0.265 1.057 0.265 0.177 0 0.345-7e-3 0.507-0.022 0.161-0.015 0.316-0.037 0.463-0.066v2.426a7.49 7.49 0 0 1-0.882 0.089 21.67 21.67 0 0 1-0.947 0.022c-0.484 0-0.944-0.034-1.377-0.1a3.233 3.233 0 0 1-1.145-0.386 2.04 2.04 0 0 1-0.782-0.816c-0.191-0.353-0.287-0.816-0.287-1.39v-6.728h-1.894v-2.096h1.894v-3.42h3.129v3.42h2.29zm4.471 0v2.118h0.044a3.907 3.907 0 0 1 1.454-1.754 4.213 4.213 0 0 1 1.036-0.497 3.734 3.734 0 0 1 1.145-0.176c0.206 0 0.433 0.037 0.683 0.11v2.912a5.862 5.862 0 0 0-0.528-0.077 5.566 5.566 0 0 0-0.595-0.033c-0.573 0-1.058 0.096-1.454 0.287a2.52 2.52 0 0 0-0.958 0.783 3.143 3.143 0 0 0-0.518 1.158 6.32 6.32 0 0 0-0.154 1.434v5.14h-3.128v-11.4zm5.684-1.765v-2.582h3.128v2.582h-3.127zm3.128 1.765v11.4h-3.127v-11.4h3.128zm1.63 0h3.569l2.005 2.978 1.982-2.978h3.459l-3.745 5.339 4.208 6.067h-3.57l-2.378-3.596-2.38 3.596h-3.502l4.097-6.001zm15.3 20.84v-30.52h-2.194v-0.732h3.035v31.98h-3.035v-0.732z"/>
+ </g>
+</svg>

www/Octicons-bug.svg

@@ -0,0 +1,36 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<svg
+   height="800.3468"
+   width="733.88495"
+   version="1.1"
+   id="svg4"
+   sodipodi:docname="Octicons-bug.svg"
+   inkscape:version="1.1 (c68e22c387, 2021-05-23)"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:svg="http://www.w3.org/2000/svg">
+  <defs
+     id="defs8" />
+  <sodipodi:namedview
+     id="namedview6"
+     pagecolor="#ffffff"
+     bordercolor="#666666"
+     borderopacity="1.0"
+     inkscape:pageshadow="2"
+     inkscape:pageopacity="0.0"
+     inkscape:pagecheckerboard="0"
+     showgrid="false"
+     inkscape:zoom="0.85253906"
+     inkscape:cx="367.1386"
+     inkscape:cy="432.23826"
+     inkscape:window-width="3828"
+     inkscape:window-height="2081"
+     inkscape:window-x="0"
+     inkscape:window-y="46"
+     inkscape:window-maximized="1"
+     inkscape:current-layer="svg4" />
+  <path
+     d="m 243.6206,76.877783 c -52.874,56.780997 -38.281,147.468997 -38.281,147.468997 0,0 53.968,64 160,64 106.031,0 160.031,-64 160.031,-64 0,0 14.375,-89.469 -37.375,-146.311997 32.375,-18.031 51.438,-44.094 43.562,-61.812 -8.938,-19.9689999 -48.375,-21.7499999 -88.25,-3.969 -14.812,6.594 -27.438,14.969 -37.25,23.875 -12.438,-2.25 -25.625,-3.781 -40.72,-3.781 -14.061,0 -26.561,1.344 -38.344,3.25 -9.656,-8.75 -22.062,-16.875 -36.531,-23.344 -39.875,-17.7189999 -79.375,-15.9379999 -88.25,3.969 -7.748,17.343 10.284,42.686 41.408,60.655 z m 401.125,413.218997 c -8.25,-1.75 -16.125,-2.75 -23.75,-3.5 0,-2.125 0.375,-4.125 0.375,-6.312 0,-33.594 -4.75,-65.654 -12.438,-96.125 16.438,1.406 37.375,-2.375 58.562,-11.779 39.875,-17.781 65,-48.375 56.125,-68.219 -8.875,-19.969 -48.375,-21.75 -88.25,-3.969 -18.625,8.312 -33.812,19.469 -44,30.906 -7.75,-18.25 -16.5,-35.781 -26.812,-51.719 -30.188,25.156 -87.312,62.719 -167.062,71.062 v 321.781 c 0,0 -0.25,32 -32.031,32 -31.75,0 -32,-32 -32,-32 v -321.657 c -79.811,-8.344 -136.968,-45.969 -167.093,-71.062 -9.875,15.312 -18.375,32 -25.938,49.344 -10.281,-10.625 -24.625,-20.844 -41.969,-28.594 -39.875,-17.719 -79.375,-15.938 -88.25,3.969 -8.9060001,19.906 16.25,50.438 56.125,68.219 19.844,8.846 39.531,12.812 55.469,12.096 -7.656,30.404 -12.469,62.344 -12.469,95.812 0,2.188 0.375,4.25 0.438,6.5 -6.719,0.75 -13.688,1.75 -20.781,3.25 -51.969,10.75 -91.7810001,37.625 -88.84400014,59.812 2.93800004,22.312 47.50000014,31.5 99.59400014,20.688 6.781,-1.375 13.438,-3.125 19.781,-5.062 9.156,40.809 23.812,78.684 44.094,111.309 -12.031,6.062 -24.531,15 -36.031,26.625 -31.876,31.875 -44.812,70.625 -28.876,86.563 15.938,15.937 54.656,3 86.531,-28.812 9.344,-9.375 16.844,-19.25 22.656,-29 43.532,42.624 98.063,68.124 157.563,68.124 60.343,0 115.781,-26.25 159.531,-69.938 5.875,10.312 13.75,20.812 23.625,30.688 31.812,31.875 70.625,44.812 86.562,28.875 15.937,-15.937 3,-54.625 -28.875,-86.5 -12.312,-12.375 -25.688,-21.75 -38.438,-27.938 20.125,-32.5 34.625,-70.375 43.688,-111.062 7.188,2.25 14.688,4.375 22.562,6.062 52.061,10.812 96.625,1.562 99.625,-20.688 2.813,-22.124 -36.999,-48.999 -88.999,-59.749 z"
+     id="path2" />
+</svg>

www/index.html

@@ -138,12 +138,12 @@
       </div>
 
       <p>
-        Need help? Ask on <a href="https://kiwiirc.com/nextclient/irc.libera.chat/#haskell-ghcup">#haskell-ghcup</a>, <a href="https://kiwiirc.com/nextclient/irc.libera.chat/#haskell">#haskell</a> or <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">report a bug</a>.
+	  Need help? Ask on <a href="https://kiwiirc.com/nextclient/irc.libera.chat/?nick=Guest%7C?#haskell,#haskell-ghcup"><img src="irc.svg" height="18px" alt="" />IRC</a>, <a href="https://discord.gg/pKYf3zDQU7"><img src="Discord-Logo-Black.svg" height="18px" alt="" />Discord</a>, <a href="https://app.element.io/#/room/#haskell-tooling:matrix.org"><img src="Matrix_logo.svg" height="25px" alt="" style="top:5px;position:relative;" /></a> or <a href="https://gitlab.haskell.org/haskell/ghcup-hs/issues">report a bug <img src="Octicons-bug.svg" height="18px" alt="" /></a>.
       </p>
 
       <p id="about">
         <img src="haskell-logo.svg" alt="" />
-        ghcup is a haskell.org hosted project.
+        ghcup is a haskell.org supported project.
         <br/>
         <a href="https://www.haskell.org/downloads/">other installation options</a>
         &nbsp;&middot;&nbsp;

www/irc.svg

@@ -0,0 +1,38 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<svg
+   height="18.043058"
+   viewBox="0 0 18 18.043058"
+   width="18"
+   version="1.1"
+   id="svg4"
+   sodipodi:docname="irc.svg"
+   inkscape:version="1.1 (c68e22c387, 2021-05-23)"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:svg="http://www.w3.org/2000/svg">
+  <defs
+     id="defs8" />
+  <sodipodi:namedview
+     id="namedview6"
+     pagecolor="#ffffff"
+     bordercolor="#666666"
+     borderopacity="1.0"
+     inkscape:pageshadow="2"
+     inkscape:pageopacity="0.0"
+     inkscape:pagecheckerboard="0"
+     showgrid="false"
+     inkscape:zoom="36.375"
+     inkscape:cx="3.3814433"
+     inkscape:cy="9.0309278"
+     inkscape:window-width="3828"
+     inkscape:window-height="2081"
+     inkscape:window-x="0"
+     inkscape:window-y="46"
+     inkscape:window-maximized="1"
+     inkscape:current-layer="svg4" />
+  <path
+     class="heroicon-ui"
+     d="m 8.03,5.0375961 h 3.94 l 1.06,-4.23999995 a 1,1 0 1 1 1.94,0.47999995 l -0.94,3.76 H 17 a 1,1 0 0 1 0,2 h -3.47 l -1,3.9999999 H 15 a 1,1 0 1 1 0,2 h -2.97 l -1.06,4.25 a 1.0004624,1.0004624 0 1 1 -1.94,-0.49 l 0.94,-3.76 H 6.03 l -1.06,4.25 a 1.0004624,1.0004624 0 1 1 -1.94,-0.49 l 0.94,-3.76 H 1 a 1,1 0 0 1 0,-2 h 3.47 l 1,-3.9999999 H 3 a 1,1 0 0 1 0,-2 H 5.97 L 7.03,0.79759615 A 1,1 0 1 1 8.97,1.2775961 Z m -0.5,2 -1,3.9999999 h 3.94 l 1,-3.9999999 z"
+     id="path2" />
+</svg>