Fix

.cirrus.yml

@@ -1,11 +1,10 @@
 freebsd_instance:
   image_family: freebsd-13-1
 
-build_task:
-  name: build
+task:
   env:
     GHC_VER: 9.2.4
-    CABAL_VER: 3.8.1.0
+    CABAL_VER: 3.6.2.0
     ARTIFACT: "x86_64-portbld-freebsd-ghcup"
     ARCH: 64
     RUNNER_OS: FreeBSD
@@ -13,10 +12,10 @@ build_task:
     GITHUB_WORKSPACE: ${CIRRUS_WORKING_DIR}
     JSON_VERSION: "0.0.7"
     CIRRUS_CLONE_SUBMODULES: true
-    AWS_ACCESS_KEY_ID: ENCRYPTED[6ed6287e2dd78ab5f84b22232c5245834ab042bd8ba443883aaf4b4d1ecc0481add1fdfad5ae6f6a8cfb418e6f19b2fc]
-    AWS_SECRET_ACCESS_KEY: ENCRYPTED[16f3cda2954c7cee99444e6788eb5997382aa4ce1477e7523fef2586077541f43b5c816156961fc6b4677259679875a7]
+    AWS_ACCESS_KEY_ID: ENCRYPTED[3e99c4ac040871f213abd616ec66952d954dc289cdd97772f88e58a74d08a2250133437780fe98b7aedf7ef1fb32f5eb]
+    AWS_SECRET_ACCESS_KEY: ENCRYPTED[5910cfd77a922ff7fc06eeb6a6b9f79d4867863e541f06eb2c4cfecae0613650e3e0588373fa8d9249d295d76cf9cb3b]
     S3_HOST: ENCRYPTED[ce961780a33159f7d1d8046956b5ac6ebc3bfc8149428e5f538576cda51d9f3d0c35b79cdd1e325793639ff6e31f889d]
-  install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake llvm14
+  install_script: pkg install -y ghc hs-cabal-install git bash misc/compat10x misc/compat11x misc/compat12x gmake
   script:
     - tzsetup Etc/GMT
     - adjkerntz -a

.github/scripts/bootstrap.sh

@@ -2,7 +2,7 @@
 
 set -eux
 
-. .github/scripts/env.sh
+. .github/scripts/prereq.sh
 
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
 
@@ -13,6 +13,4 @@ git describe --always
 ./scripts/bootstrap/bootstrap-haskell
 
 [ "$(ghc --numeric-version)" = "${BOOTSTRAP_HASKELL_GHC_VERSION}" ]
-# https://github.com/actions/runner-images/issues/7061
-[ "$(ghcup config | grep --color=never meta-mode)" = "meta-mode: Lax" ]
 

.github/scripts/brew.sh

@@ -1,27 +0,0 @@
-#!/bin/sh
-
-set -eux
-
-. .github/scripts/env.sh
-
-if [ -e "$HOME/.brew" ] ; then
-	(
-	cd "$HOME/.brew"
-	git fetch --depth 1
-	git reset --hard origin/master
-	)
-else
-	git clone --depth=1 https://github.com/Homebrew/brew "$HOME/.brew"
-fi
-export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
-
-mkdir -p $CI_PROJECT_DIR/.brew_cache
-export HOMEBREW_CACHE=$CI_PROJECT_DIR/.brew_cache
-mkdir -p $CI_PROJECT_DIR/.brew_logs
-export HOMEBREW_LOGS=$CI_PROJECT_DIR/.brew_logs
-mkdir -p /private/tmp/.brew_tmp
-export HOMEBREW_TEMP=/private/tmp/.brew_tmp
-
-brew update
-brew install ${1+"$@"}
-

.github/scripts/build.sh

@@ -2,34 +2,75 @@
 
 set -eux
 
+. .github/scripts/prereq.sh
 . .github/scripts/common.sh
 
+
+# ensure ghcup
+if ! command -v ghcup ; then
+	install_ghcup
+fi
+
+# ensure cabal-cache
+if ! cabal-cache version ; then
+	download_cabal_cache "$HOME/.local/bin/cabal-cache"
+fi
+
+# ensure ghc
+if [ "${RUNNER_OS}" != "FreeBSD" ] ; then
+	if [ "${DISTRO}" != "Debian" ] ; then # ! armv7 or aarch64 linux
+		if ! "ghc-${GHC_VER}" --numeric-version ; then
+			ghcup -v install ghc --set --force "$GHC_VER"
+		fi
+		if [ "$(cabal --numeric-version || true)" != "${CABAL_VER}" ] ; then
+			ghcup -v install cabal --force "$CABAL_VER"
+		fi
+		ghc --version
+		cabal --version
+		GHC="ghc-${GHC_VER}"
+	else
+		if [ "$(cabal --numeric-version || true)" != "${CABAL_VER}" ] ; then
+			ghcup -v install cabal --force "$CABAL_VER"
+		fi
+		cabal --version
+		GHC="ghc"
+	fi
+else
+	ghc --version
+	cabal --version
+	GHC="ghc"
+fi
+
 git_describe
 
-# ensure ghcup
-install_ghcup
-
-# ensure cabal-cache
-download_cabal_cache "$HOME/.local/bin/cabal-cache"
-
-# install toolchain (if necessary)
-ghcup -v install ghc --set --force "$GHC_VER"
-ghcup -v install cabal --force "$CABAL_VER"
-ghc --version
-cabal --version
-GHC="ghc-${GHC_VER}"
 
 # build
 ecabal update
-build_with_cache --project-file=cabal.project.release -w "${GHC}" --enable-tests
+
+if [ "${RUNNER_OS}" = "Linux" ] ; then
+	if [ "${ARCH}" = "32" ] ; then
+		build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
+	elif [ "${ARCH}" = "64" ] ; then
+		build_with_cache -w "${GHC}" --ghc-options='-split-sections -optl-static' -ftui --enable-tests
+	else
+		build_with_cache -w "${GHC}" -ftui --enable-tests
+	fi
+elif [ "${RUNNER_OS}" = "FreeBSD" ] ; then
+	build_with_cache -w "${GHC}" --ghc-options='-split-sections' --constraint="zlib +bundled-c-zlib" --constraint="zip +disable-zstd" -ftui --enable-tests
+elif [ "${RUNNER_OS}" = "Windows" ] ; then
+	build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" --enable-tests
+else
+	build_with_cache -w "${GHC}" --constraint="zlib +bundled-c-zlib" --constraint="lzma +static" -ftui --enable-tests
+fi
+
 
 # set up artifacts
 mkdir -p out
-binary=$(cabal --project-file=cabal.project.release list-bin ghcup)
-binary_test=$(cabal --project-file=cabal.project.release list-bin ghcup-test)
+binary=$(cabal list-bin ghcup)
+binary_test=$(cabal list-bin ghcup-test)
 ver=$("${binary}" --numeric-version)
 strip_binary "${binary}"
-cp "${binary}" "out/${ARTIFACT}-${ver}${ext}"
-cp "${binary_test}" "out/test-${ARTIFACT}-${ver}${ext}"
+cp "${binary}" "out/${ARTIFACT}-${ver}"
+cp "${binary_test}" "out/test-${ARTIFACT}-${ver}"
 cp ./dist-newstyle/cache/plan.json "out/${ARTIFACT}.plan.json"
 

.github/scripts/common.sh

@@ -1,13 +1,23 @@
 #!/bin/sh
 
-. .github/scripts/env.sh
+if [ "${RUNNER_OS}" = "Windows" ] ; then
+	ext=".exe"
+else
+	ext=''
+fi
 
 ecabal() {
 	cabal "$@"
 }
 
-nonfatal() {
-	"$@" || "$* failed"
+sync_from_retry() {
+	if [ "${RUNNER_OS}" != "Windows" ] ; then
+		cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
+	else
+		cabal_store_path="${CABAL_DIR}/store"
+	fi
+
+    sync_from || { sleep 9 ; rm -rf "${cabal_store_path:?}"/* ; sync_from || { sleep 20 ; rm -rf "${cabal_store_path:?}"/* ; sync_from ; } }
 }
 
 sync_from() {
@@ -24,6 +34,10 @@ sync_from() {
 		--archive-uri "s3://ghcup-hs/${RUNNER_OS}-${ARCH}-${DISTRO}"
 }
 
+sync_to_retry() {
+    sync_to || { sleep 9 ; sync_to || { sleep 20 ; sync_to ; } }
+}
+
 sync_to() {
 	if [ "${RUNNER_OS}" != "Windows" ] ; then
 		cabal_store_path="$(dirname "$(cabal help user-config | tail -n 1 | xargs)")/store"
@@ -67,7 +81,6 @@ git_describe() {
 download_cabal_cache() {
 	(
 	set -e
-	mkdir -p "$HOME/.local/bin"
 	dest="$HOME/.local/bin/cabal-cache"
     url=""
 	exe=""
@@ -121,36 +134,25 @@ download_cabal_cache() {
 build_with_cache() {
 	ecabal configure "$@"
 	ecabal build --dependencies-only "$@" --dry-run
-	sync_from
-	ecabal build --dependencies-only "$@" || sync_to
-	sync_to
+	sync_from_retry
+	ecabal build --dependencies-only "$@" || sync_to_retry
+	sync_to_retry
 	ecabal build "$@"
-	sync_to
+	sync_to_retry
 }
 
 install_ghcup() {
-	case "${RUNNER_OS}" in
-		"Linux")
-			case "${ARCH}" in
-				"ARM"*)
-					if command -v ghcup ; then
-						mkdir -p "$GHCUP_BIN"
-						cp "$(command -v ghcup)" "$GHCUP_BIN/ghcup${ext}"
-					else
-						install_ghcup_curl_sh
-					fi
-					;;
-				*) install_ghcup_curl_sh
-					;;
-			esac
-			;;
-			*) install_ghcup_curl_sh
-			;;
-	esac
-}
+	find "$GHCUP_INSTALL_BASE_PREFIX"
+	mkdir -p "$GHCUP_BIN"
+	mkdir -p "$GHCUP_BIN"/../cache
 
-install_ghcup_curl_sh() {
-	curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh
+	if [ "${RUNNER_OS}" = "FreeBSD" ] ; then
+		curl -o ghcup https://downloads.haskell.org/ghcup/tmp/x86_64-portbld-freebsd-ghcup-0.1.18.1
+		chmod +x ghcup
+		mv ghcup "$HOME/.local/bin/ghcup"
+	else
+		curl --proto '=https' --tlsv1.2 -sSf https://get-ghcup.haskell.org | BOOTSTRAP_HASKELL_NONINTERACTIVE=1 BOOTSTRAP_HASKELL_MINIMAL=1 BOOTSTRAP_HASKELL_INSTALL_NO_STACK=yes sh
+	fi
 }
 
 strip_binary() {

.github/scripts/env.sh

@@ -1,30 +0,0 @@
-#!/bin/sh
-
-if [ "${RUNNER_OS}" = "Windows" ] ; then
-	ext=".exe"
-else
-	ext=''
-fi
-
-export DEBIAN_FRONTEND=noninteractive
-export TZ=Asia/Singapore
-
-export OS="$RUNNER_OS"
-export PATH="$HOME/.local/bin:$PATH"
-
-if [ "${RUNNER_OS}" = "Windows" ] ; then
-	# on windows use pwd to get unix style path
-	CI_PROJECT_DIR="$(pwd)"
-	export CI_PROJECT_DIR
-    export GHCUP_INSTALL_BASE_PREFIX="/c"
-    export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
-    export PATH="$GHCUP_BIN:$PATH"
-	export CABAL_DIR="C:\\Users\\runneradmin\\AppData\\Roaming\\cabal"
-else
-	export CI_PROJECT_DIR="${GITHUB_WORKSPACE}"
-    export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
-    export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/.ghcup/bin"
-    export PATH="$GHCUP_BIN:$PATH"
-    export CABAL_DIR="$CI_PROJECT_DIR/cabal"
-    export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
-fi

.github/scripts/hls.sh

@@ -2,6 +2,7 @@
 
 set -eux
 
+. .github/scripts/prereq.sh
 . .github/scripts/common.sh
 
 mkdir -p "$CI_PROJECT_DIR"/.local/bin
@@ -33,7 +34,7 @@ sha_sum "$(raw_eghcup --offline whereis ghcup)"
 git_describe
 
 eghcup install ghc "${GHC_VERSION}"
-eghcup install cabal "${CABAL_VERSION}"
+eghcup install cabal
 
 ecabal update
 
@@ -56,9 +57,9 @@ eghcup debug-info
 	cd "haskell-language-server-${HLS_TARGET_VERSION}/"
 	ecabal configure -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)"
 	ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" --dry-run
-	sync_from
+	sync_from_retry
 	ecabal build --dependencies-only -w "ghc-${GHC_VERSION}" --disable-profiling --disable-tests --jobs="$(nproc)" || sync_to
-	sync_to
+	sync_to_retry
 )
 
 eghcup -v compile hls -j "$(nproc)" -g "${HLS_TARGET_VERSION}" --ghc "${GHC_VERSION}"

.github/scripts/prereq.sh

@@ -0,0 +1,66 @@
+#!/bin/sh
+
+mkdir -p "$HOME"/.local/bin
+
+export OS="$RUNNER_OS"
+export PATH="$HOME/.local/bin:$PATH"
+: "${APT_GET:=apt-get}"
+
+if [ "${RUNNER_OS}" = "Windows" ] ; then
+	# on windows use pwd to get unix style path
+	CI_PROJECT_DIR="$(pwd)"
+	export CI_PROJECT_DIR
+    export GHCUP_INSTALL_BASE_PREFIX="/c"
+    export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/ghcup/bin"
+    export PATH="$GHCUP_BIN:$PATH"
+	export CABAL_DIR="C:\\Users\\runneradmin\\AppData\\Roaming\\cabal"
+else
+	export CI_PROJECT_DIR="${GITHUB_WORKSPACE}"
+    export GHCUP_INSTALL_BASE_PREFIX="$CI_PROJECT_DIR"
+    export GHCUP_BIN="$GHCUP_INSTALL_BASE_PREFIX/.ghcup/bin"
+    export PATH="$GHCUP_BIN:$PATH"
+    export CABAL_DIR="$CI_PROJECT_DIR/cabal"
+    export CABAL_CACHE="$CI_PROJECT_DIR/cabal-cache"
+fi
+
+if [ "${RUNNER_OS}" = "Linux" ] ; then
+	if [ "${DISTRO}" = "Alpine" ] ; then
+		:
+	elif [ "${DISTRO}" = "Ubuntu" ] ; then
+		export DEBIAN_FRONTEND=noninteractive
+		export TZ=Asia/Singapore
+		if [ "${ARCH}" = "ARM64" ] || [ "${ARCH}" = "ARM" ] ; then
+			:
+		else
+			${APT_GET} install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
+		fi
+	elif [ "${DISTRO}" = "Debian" ] ; then
+		export DEBIAN_FRONTEND=noninteractive
+		export TZ=Asia/Singapore
+		${APT_GET} install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl ghc gzip
+	fi
+elif [ "${RUNNER_OS}" = "macOS" ] ; then
+	if ! command -v brew ; then
+		[ -e "$HOME/.brew" ] ||
+			git clone --depth=1 https://github.com/Homebrew/brew "$HOME/.brew"
+		export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
+		brew update
+	fi
+	if ! command -v git ; then
+		brew install git
+	fi
+	if ! command -v realpath ; then
+		brew install coreutils
+	fi
+
+    if [ "${ARCH}" = "ARM64" ] ; then
+		brew install llvm@11 autoconf automake
+		export PATH="$HOME/.brew/opt/llvm@11/bin:$PATH"
+		export CC="$HOME/.brew/opt/llvm@11/bin/clang"
+		export CXX="$HOME/.brew/opt/llvm@11/bin/clang++"
+		export LD=ld
+		export AR="$HOME/.brew/opt/llvm@11/bin/llvm-ar"
+		export RANLIB="$HOME/.brew/opt/llvm@11/bin/llvm-ranlib"
+	fi
+fi
+

.github/scripts/test.sh

@@ -2,6 +2,7 @@
 
 set -eux
 
+. .github/scripts/prereq.sh
 . .github/scripts/common.sh
 
 
@@ -190,7 +191,7 @@ 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://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-0.0.7.yaml list
+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")
@@ -200,7 +201,7 @@ sha2=$(sha_sum "${GHCUP_DIR}/cache/ghcup-${JSON_VERSION}.yaml")
 # 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://raw.githubusercontent.com/haskell/ghcup-metadata/exp/ghcup-0.0.7.yaml list
+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}" ]

.github/workflows/bootstrap.yaml

@@ -20,6 +20,7 @@ jobs:
       BOOTSTRAP_HASKELL_NONINTERACTIVE: yes
       ARCH: 64
       JSON_VERSION: "0.0.7"
+      APT_GET: "sudo apt-get"
     strategy:
       matrix:
         include:
@@ -35,15 +36,7 @@ jobs:
         with:
           submodules: 'true'
 
-      - if: runner.os == 'Linux'
-        name: Run bootstrap
-        run: |
-          sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
-          sh ./.github/scripts/bootstrap.sh
-        env:
-          DISTRO: ${{ matrix.DISTRO }}
-
-      - if: runner.os == 'macOS'
+      - if: runner.os != 'Windows'
         name: Run bootstrap
         run: sh ./.github/scripts/bootstrap.sh
         env:

.github/workflows/cache.yaml

@@ -29,7 +29,7 @@ jobs:
       with:
         args: --recursive
       env:
-        AWS_S3_ENDPOINT: https://${{ secrets.S3_HOST }}
+        AWS_S3_ENDPOINT: ${{ secrets.S3_HOST }}
         AWS_S3_BUCKET: ghcup-hs
         AWS_REGION: us-west-2
         AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}

.github/workflows/docker.yaml

@@ -6,7 +6,7 @@ on:
     - cron: '0 0 * * *'
 
 jobs:
-  docker-alpine32:
+  docker-alpine:
     runs-on: ubuntu-latest
     steps:
       - name: Checkout
@@ -26,24 +26,7 @@ jobs:
           context: ./docker/alpine32
           push: true
           tags: hasufell/i386-alpine-haskell:3.12
-          platforms: |
-            linux/i386
-            linux/amd64
-
-  docker-alpine:
-    runs-on: ubuntu-latest
-    steps:
-      - name: Checkout
-        uses: actions/checkout@v3
-      - name: Set up QEMU
-        uses: docker/setup-qemu-action@v2
-      - name: Set up Docker Buildx
-        uses: docker/setup-buildx-action@v2
-      - name: Login to Docker Hub
-        uses: docker/login-action@v2
-        with:
-          username: ${{ secrets.DOCKERHUB_USERNAME }}
-          password: ${{ secrets.DOCKERHUB_TOKEN }}
+          platforms: linux/i386
       - name: Build and push (alpine 64bit)
         uses: docker/build-push-action@v3
         with:
@@ -52,74 +35,34 @@ jobs:
           tags: hasufell/alpine-haskell:3.12
           platforms: linux/amd64
 
-  docker-arm32:
-    runs-on: [self-hosted, Linux, ARM64, aarch32-linux]
+  docker-arm:
+    runs-on: [self-hosted, Linux, aarch64]
     steps:
       - uses: docker://arm64v8/ubuntu:focal
-        name: Cleanup (aarch64 linux)
+        name: Cleanup
         with:
-          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
+          args: rm -rf .ghcup/ cabal/ dist-newstyle/ out/
 
       - name: Checkout
         uses: actions/checkout@v3
-
       - name: Set up Docker Buildx
         uses: docker/setup-buildx-action@v2
-
       - name: Login to Docker Hub
         uses: docker/login-action@v2
         with:
           username: ${{ secrets.DOCKERHUB_USERNAME }}
           password: ${{ secrets.DOCKERHUB_TOKEN }}
-
-      - name: Build and push (debian buster)
+      - name: Build and push (arm64v8)
         uses: docker/build-push-action@v3
         with:
-          context: ./docker/arm32v7/buster
+          context: ./docker/arm64v8/
           push: true
-          tags: hasufell/arm32v7-debian-haskell:10
-          platforms: linux/arm
-
-      - name: Build and push (ubuntu focal)
-        uses: docker/build-push-action@v3
-        with:
-          context: ./docker/arm32v7/focal
-          push: true
-          tags: hasufell/arm32v7-debian-haskell:10
-          platforms: linux/arm
-
-  docker-aarch:
-    runs-on: [self-hosted, Linux, ARM64]
-    steps:
-      - uses: docker://arm64v8/ubuntu:focal
-        name: Cleanup (aarch64 linux)
-        with:
-          args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
-
-      - name: Checkout
-        uses: actions/checkout@v3
-
-      - name: Set up Docker Buildx
-        uses: docker/setup-buildx-action@v2
-
-      - name: Login to Docker Hub
-        uses: docker/login-action@v2
-        with:
-          username: ${{ secrets.DOCKERHUB_USERNAME }}
-          password: ${{ secrets.DOCKERHUB_TOKEN }}
-
-      - name: Build and push (debian buster)
-        uses: docker/build-push-action@v3
-        with:
-          context: ./docker/arm64v8/buster
-          push: true
-          tags: hasufell/arm64v8-debian-haskell:10
+          tags: hasufell/arm64v8-ubuntu-haskell:focal
           platforms: linux/arm64
-
-      - name: Build and push (ubuntu focal)
+      - name: Build and push (arm32v7)
         uses: docker/build-push-action@v3
         with:
-          context: ./docker/arm64v8/focal
+          context: ./docker/arm32v7
           push: true
-          tags: hasufell/arm64v8-debian-haskell:10
-          platforms: linux/arm64
+          tags: hasufell/arm32v7-ubuntu-haskell:focal
+          platforms: linux/arm

.github/workflows/release.yaml

@@ -17,7 +17,7 @@ jobs:
     name: Build linux binary
     runs-on: ${{ matrix.os }}
     env:
-      CABAL_VER: 3.8.1.0
+      CABAL_VER: 3.6.2.0
       JSON_VERSION: "0.0.7"
       AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
       AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -81,7 +81,7 @@ jobs:
     name: Build ARM binary
     runs-on: ${{ matrix.os }}
     env:
-      CABAL_VER: 3.8.1.0
+      CABAL_VER: 3.6.2.0
       JSON_VERSION: "0.0.7"
       AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
       AWS_ACCESS_KEY_ID: ${{ secrets.AWS_ACCESS_KEY_ID }}
@@ -90,16 +90,16 @@ jobs:
       fail-fast: true
       matrix:
         include:
-          - os: [self-hosted, Linux, ARM64, aarch32-linux]
+          - os: [self-hosted, Linux, aarch64]
             ARTIFACT: "armv7-linux-ghcup"
-            GHC_VER: 9.2.2
+            GHC_VER: 8.10.7
             ARCH: ARM
-          - os: [self-hosted, Linux, ARM64]
+          - os: [self-hosted, Linux, aarch64]
             ARTIFACT: "aarch64-linux-ghcup"
-            GHC_VER: 9.2.5
+            GHC_VER: 8.10.7
             ARCH: ARM64
     steps:
-      - uses: docker://arm64v8/debian:10
+      - uses: docker://arm64v8/ubuntu:focal
         name: Cleanup (aarch64 linux)
         with:
           args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
@@ -115,7 +115,7 @@ jobs:
           submodules: 'true'
 
       - if: matrix.ARCH == 'ARM'
-        uses: docker://hasufell/arm32v7-debian-haskell:10
+        uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
         name: Run build (armv7 linux)
         with:
           args: sh .github/scripts/build.sh
@@ -129,7 +129,7 @@ jobs:
           S3_HOST: ${{ env.S3_HOST }}
 
       - if: matrix.ARCH == 'ARM64'
-        uses: docker://hasufell/arm64v8-debian-haskell:10
+        uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
         name: Run build (aarch64 linux)
         with:
           args: sh .github/scripts/build.sh
@@ -154,7 +154,7 @@ jobs:
     name: Build binary (Mac/Win)
     runs-on: ${{ matrix.os }}
     env:
-      CABAL_VER: 3.8.1.0
+      CABAL_VER: 3.6.2.0
       MACOSX_DEPLOYMENT_TARGET: 10.13
       JSON_VERSION: "0.0.7"
       AWS_SECRET_ACCESS_KEY: ${{ secrets.AWS_SECRET_ACCESS_KEY }}
@@ -164,7 +164,7 @@ jobs:
       fail-fast: false
       matrix:
         include:
-          - os: [self-hosted, macOS, ARM64]
+          - os: [self-hosted, macOS, aarch64]
             ARTIFACT: "aarch64-apple-darwin-ghcup"
             GHC_VER: 9.2.5
             ARCH: ARM64
@@ -182,48 +182,8 @@ jobs:
         with:
           submodules: 'true'
 
-      - if: matrix.ARCH == 'ARM64' && runner.os == 'macOS'
-        name: Run build
-        run: |
-          bash .github/scripts/brew.sh git coreutils llvm@11 autoconf automake
-          export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$HOME/.brew/opt/llvm@11/bin:$PATH"
-          export CC="$HOME/.brew/opt/llvm@11/bin/clang"
-          export CXX="$HOME/.brew/opt/llvm@11/bin/clang++"
-          export LD=ld
-          export AR="$HOME/.brew/opt/llvm@11/bin/llvm-ar"
-          export RANLIB="$HOME/.brew/opt/llvm@11/bin/llvm-ranlib"
-          bash .github/scripts/build.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: na
-          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
-          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
-          S3_HOST: ${{ env.S3_HOST }}
-          HOMEBREW_CHANGE_ARCH_TO_ARM: 1
-
-      - if: matrix.ARCH == '64' && runner.os == 'macOS'
-        name: Run build (windows/mac)
-        run: |
-          bash .github/scripts/brew.sh coreutils
-          export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
-          bash .github/scripts/build.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: na
-          AWS_SECRET_ACCESS_KEY: ${{ env.AWS_SECRET_ACCESS_KEY }}
-          AWS_ACCESS_KEY_ID: ${{ env.AWS_ACCESS_KEY_ID }}
-          S3_HOST: ${{ env.S3_HOST }}
-          HOMEBREW_CHANGE_ARCH_TO_ARM: 1
-
-      - if: runner.os == 'Windows'
-        name: Run build (windows/mac)
-        run: |
-          bash .github/scripts/brew.sh git coreutils autoconf automake
-          bash .github/scripts/build.sh
+      - name: Run build (windows/mac)
+        run: bash .github/scripts/build.sh
         env:
           ARTIFACT: ${{ matrix.ARTIFACT }}
           ARCH: ${{ matrix.ARCH }}
@@ -242,12 +202,13 @@ jobs:
           path: |
             ./out/*
 
+
   test-linux:
     name: Test linux
     needs: "build-linux"
     runs-on: ${{ matrix.os }}
     env:
-      CABAL_VER: 3.8.1.0
+      CABAL_VER: 3.6.2.0
       JSON_VERSION: "0.0.7"
     strategy:
       matrix:
@@ -303,14 +264,13 @@ jobs:
 
       - if: matrix.DISTRO != 'Alpine'
         name: Run test (64 bit linux)
-        run: |
-          sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
-          sh .github/scripts/test.sh
+        run: sh .github/scripts/test.sh
         env:
           ARTIFACT: ${{ matrix.ARTIFACT }}
           ARCH: ${{ matrix.ARCH }}
           GHC_VER: ${{ matrix.GHC_VER }}
           DISTRO: ${{ matrix.DISTRO }}
+          APT_GET: "sudo apt-get"
 
       - if: failure()
         name: Upload artifact
@@ -325,24 +285,24 @@ jobs:
     needs: "build-arm"
     runs-on: ${{ matrix.os }}
     env:
-      CABAL_VER: 3.8.1.0
+      CABAL_VER: 3.6.2.0
       JSON_VERSION: "0.0.7"
     strategy:
       matrix:
         include:
-          - os: [self-hosted, Linux, ARM64, aarch32-linux]
+          - os: [self-hosted, Linux, aarch64]
             ARTIFACT: "armv7-linux-ghcup"
-            GHC_VER: 9.2.2
+            GHC_VER: 8.10.7
             ARCH: ARM
             DISTRO: Ubuntu
-          - os: [self-hosted, Linux, ARM64]
+          - os: [self-hosted, Linux, aarch64]
             ARTIFACT: "aarch64-linux-ghcup"
-            GHC_VER: 9.2.5
+            GHC_VER: 8.10.7
             ARCH: ARM64
             DISTRO: Ubuntu
 
     steps:
-      - uses: docker://arm64v8/debian:10
+      - uses: docker://arm64v8/ubuntu:focal
         name: Cleanup (aarch64 linux)
         with:
           args: "find . -mindepth 1 -maxdepth 1 -exec rm -rf -- {} +"
@@ -358,7 +318,7 @@ jobs:
           path: ./out
 
       - if: matrix.ARCH == 'ARM'
-        uses: docker://hasufell/arm32v7-debian-haskell:10
+        uses: docker://hasufell/arm32v7-ubuntu-haskell:focal
         name: Run test (armv7 linux)
         with:
           args: sh .github/scripts/test.sh
@@ -369,7 +329,7 @@ jobs:
           DISTRO: Ubuntu
 
       - if: matrix.ARCH == 'ARM64'
-        uses: docker://hasufell/arm64v8-debian-haskell:10
+        uses: docker://hasufell/arm64v8-ubuntu-haskell:focal
         name: Run test (aarch64 linux)
         with:
           args: sh .github/scripts/test.sh
@@ -392,13 +352,13 @@ jobs:
     needs: "build-macwin"
     runs-on: ${{ matrix.os }}
     env:
-      CABAL_VER: 3.8.1.0
+      CABAL_VER: 3.6.2.0
       MACOSX_DEPLOYMENT_TARGET: 10.13
       JSON_VERSION: "0.0.7"
     strategy:
       matrix:
         include:
-          - os: [self-hosted, macOS, ARM64]
+          - os: [self-hosted, macOS, aarch64]
             ARTIFACT: "aarch64-apple-darwin-ghcup"
             GHC_VER: 9.2.5
             ARCH: ARM64
@@ -425,21 +385,7 @@ jobs:
           name: artifacts
           path: ./out
 
-      - if: runner.os == 'macOS'
-        name: Run test
-        run: |
-          bash .github/scripts/brew.sh coreutils
-          export PATH="$HOME/.brew/bin:$HOME/.brew/sbin:$PATH"
-          bash .github/scripts/test.sh
-        env:
-          ARTIFACT: ${{ matrix.ARTIFACT }}
-          ARCH: ${{ matrix.ARCH }}
-          GHC_VER: ${{ matrix.GHC_VER }}
-          DISTRO: ${{ matrix.DISTRO }}
-          HOMEBREW_CHANGE_ARCH_TO_ARM: 1
-
-      - if: runner.os != 'macOS'
-        name: Run test
+      - name: Run test (windows/mac)
         run: bash .github/scripts/test.sh
         env:
           ARTIFACT: ${{ matrix.ARTIFACT }}
@@ -470,7 +416,7 @@ jobs:
     env:
       GHC_VERSION: "8.10.7"
       HLS_TARGET_VERSION: "1.8.0.0"
-      CABAL_VERSION: "3.8.1.0"
+      CABAL_VERSION: "3.6.2.0"
       JSON_VERSION: "0.0.7"
       ARTIFACT: "x86_64-linux-ghcup"
       DISTRO: Ubuntu
@@ -490,9 +436,9 @@ jobs:
           path: ./out
 
       - name: Run hls build
-        run: |
-          sudo apt-get install -y libnuma-dev zlib1g-dev libgmp-dev libgmp10 libssl-dev liblzma-dev libbz2-dev git wget lsb-release software-properties-common gnupg2 apt-transport-https gcc autoconf automake build-essential curl gzip
-          sh .github/scripts/hls.sh
+        run: sh .github/scripts/hls.sh
+        env:
+          APT_GET: "sudo apt-get"
 
   release:
     name: release

.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

CHANGELOG.md

@@ -1,34 +1,5 @@
 # Revision history for ghcup
 
-## 0.1.19.1 -- 2023-2-19
-
-* Fix GHCup on JFS/ReiserFS and other filesystem that don't support `d_type`, fixes [#766](https://github.com/haskell/ghcup-hs/issues/766)
-* Don't fail on setModificationTime, fixes [#784](https://github.com/haskell/ghcup-hs/issues/784) and many GitHub actions issues
-* Make armv7/aarch64 linux binaries more portable (built on Debian buster)
-* Improve usability on 'ghcup config add-release-channel', fixes [#751](https://github.com/haskell/ghcup-hs/issues/751)
-* Make version shortcuts work with 'ghcup set', fixes [#757](https://github.com/haskell/ghcup-hs/issues/757)
-* Don't implicitly smuggle in config options in `ghcup config set` wrt [#775](https://github.com/haskell/ghcup-hs/issues/775)
-* Fix build on unix with -ftui
-
-## 0.1.19.0 -- 2023-1-13
-
-* restore proper support for FreeBSD and Linux armv7
-* integrate with [errors.haskell.org](https://errors.haskell.org/index.html), wrt [#434](https://github.com/haskell/ghcup-hs/issues/434)
-* allow to overwrite distro detection via config wrt [#421](https://github.com/haskell/ghcup-hs/issues/421)
-    - this is particularly useful for e.g. Ubuntu derivates, where ghcup doesn't pick the optimal bindist, also see the [GHCup documentation on overriding distro detection](https://www.haskell.org/ghcup/guide/#overriding-distro-detection)
-* Add proper support for mirrors wrt [#357](https://github.com/haskell/ghcup-hs/issues/357)
-* fix a (harmless) bug in `ghcup nuke` on windows
-* improvements to `ghcup add-release-channel` wrt [#708](https://github.com/haskell/ghcup-hs/issues/708)
-* fix building newer GHC from source wrt [#433](https://github.com/haskell/ghcup-hs/issues/433)
-* Fix `ghcup install hls -u` on windows
-* Fix failure with `--isolate=dir --force`
-* Add `--metadata-fetching-mode` arg, fixes [#440](https://github.com/haskell/ghcup-hs/issues/440)
-* Add content-length property to downloads
-* [Fix a grave bug on armv7](https://github.com/haskell/ghcup-hs/commit/78ee956df2618862f421178a565c82548ff7e578) during installation wrt [#415](https://github.com/haskell/ghcup-hs/issues/415)
-* improve many warning/error messages (contributions by @taylorfausak)
-* some minor optimization in `ghcup whereis ghcup`
-* improve `--keep=always` to not clean up directories in certain circumstances
-
 ## 0.1.18.1 -- 2022-08-06
 
 * fix sdist and unbreak hackage, wrt [#399](https://gitlab.haskell.org/haskell/ghcup-hs/-/issues/399)

app/ghcup/AnsiMain.hs

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

app/ghcup/BrickMain.hs

@@ -95,11 +95,11 @@ data BrickState = BrickState
 keyHandlers :: KeyBindings
             -> [ ( Vty.Key
                  , BrickSettings -> String
-                 , BrickState -> EventM String BrickState ()
+                 , BrickState -> EventM n (Next BrickState)
                  )
                ]
 keyHandlers KeyBindings {..} =
-  [ (bQuit, const "Quit"     , \_ -> halt)
+  [ (bQuit, const "Quit"     , halt)
   , (bInstall, const "Install"  , withIOAction install')
   , (bUninstall, const "Uninstall", withIOAction del')
   , (bSet, const "Set"      , withIOAction set')
@@ -114,14 +114,14 @@ keyHandlers KeyBindings {..} =
        if showAllTools then "Don't show all tools" else "Show all tools"
     , hideShowHandler showAllVersions (not . showAllTools)
     )
-  , (bUp, const "Up", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Up, .. })
-  , (bDown, const "Down", \BrickState {..} -> put BrickState{ appState = moveCursor 1 appState Down, .. })
+  , (bUp, const "Up", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Up, .. })
+  , (bDown, const "Down", \BrickState {..} -> continue BrickState{ appState = moveCursor 1 appState Down, .. })
   ]
  where
   hideShowHandler f p BrickState{..} =
     let newAppSettings   = appSettings { showAllVersions = f appSettings , showAllTools = p appSettings }
         newInternalState = constructList appData newAppSettings (Just appState)
-    in  put (BrickState appData newAppSettings newInternalState appKeys)
+    in  continue (BrickState appData newAppSettings newInternalState appKeys)
 
 
 showKey :: Vty.Key -> String
@@ -142,7 +142,7 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
 
  where
   footer =
-    withAttr (attrName "help")
+    withAttr "help"
       . txtWrap
       . T.pack
       . foldr1 (\x y -> x <> "  " <> y)
@@ -157,9 +157,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
   renderList' = withDefAttr listAttr . drawListElements renderItem True
   renderItem _ b listResult@ListResult{..} =
     let marks = if
-          | lSet       -> (withAttr (attrName "set") $ str "✔✔")
-          | lInstalled -> (withAttr (attrName "installed") $ str "✓ ")
-          | otherwise  -> (withAttr (attrName "not-installed") $ str "✗ ")
+          | lSet       -> (withAttr "set" $ str "✔✔")
+          | lInstalled -> (withAttr "installed" $ str "✓ ")
+          | otherwise  -> (withAttr "not-installed" $ str "✗ ")
         ver = case lCross of
           Nothing -> T.unpack . prettyVer $ lVer
           Just c  -> T.unpack (c <> "-" <> prettyVer lVer)
@@ -167,13 +167,13 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
           | lNoBindist && not lInstalled
             && not b -- TODO: overloading dim and active ignores active
                        --       so we hack around it here
-          = updateAttrMap (const dimAttrs) . withAttr (attrName "no-bindist")
+          = updateAttrMap (const dimAttrs) . withAttr "no-bindist"
           | otherwise  = id
         hooray
           | elem Latest lTag && not lInstalled =
-              withAttr (attrName "hooray")
+              withAttr "hooray"
           | otherwise = id
-        active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr (attrName "active") else id
+        active = if b then putCursor "GHCup" (Location (0,0)) . forceAttr "active" else id
     in  hooray $ active $ dim
           (   marks
           <+> padLeft (Pad 2)
@@ -195,9 +195,9 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
           <+> vLimit 1 (fill ' ')
           )
 
-  printTag Recommended    = Just $ withAttr (attrName "recommended") $ str "recommended"
-  printTag Latest         = Just $ withAttr (attrName "latest") $ str "latest"
-  printTag Prerelease     = Just $ withAttr (attrName "prerelease") $ str "prerelease"
+  printTag Recommended    = Just $ withAttr "recommended" $ str "recommended"
+  printTag Latest         = Just $ withAttr "latest" $ str "latest"
+  printTag Prerelease     = Just $ withAttr "prerelease" $ str "prerelease"
   printTag (Base pvp'')   = Just $ str ("base-" ++ T.unpack (prettyPVP pvp''))
   printTag Old            = Nothing
   printTag (UnknownTag t) = Just $ str t
@@ -209,10 +209,10 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
   printTool Stack = str "Stack"
 
   printNotes ListResult {..} =
-    (if hlsPowered then [withAttr (attrName "hls-powered") $ str "hls-powered"] else mempty
+    (if hlsPowered then [withAttr "hls-powered" $ str "hls-powered"] else mempty
       )
-      ++ (if fromSrc then [withAttr (attrName "compiled") $ str "compiled"] else mempty)
-      ++ (if lStray then [withAttr (attrName "stray") $ str "stray"] else mempty)
+      ++ (if fromSrc then [withAttr "compiled" $ str "compiled"] else mempty)
+      ++ (if lStray then [withAttr "stray" $ str "stray"] else mempty)
 
   -- | Draws the list elements.
   --
@@ -242,8 +242,8 @@ ui dimAttrs BrickState{ appSettings = as@BrickSettings{}, ..}
               selItemAttr = if foc
                 then withDefAttr listSelectedFocusedAttr
                 else withDefAttr listSelectedAttr
-              makeVisible' = if isSelected then visible . selItemAttr else id
-          in  addSeparator $ makeVisible' elemWidget
+              makeVisible = if isSelected then visible . selItemAttr else id
+          in  addSeparator $ makeVisible elemWidget
 
       in render
         $ viewport "GHCup" Vertical
@@ -258,8 +258,8 @@ minHSize s' = hLimit s' . vLimit 1 . (<+> fill ' ')
 app :: AttrMap -> AttrMap -> App BrickState e String
 app attrs dimAttrs =
   App { appDraw         = \st -> [ui dimAttrs st]
-  , appHandleEvent  = \be -> get >>= \s -> eventHandler s be
-  , appStartEvent   = return ()
+  , appHandleEvent  = eventHandler
+  , appStartEvent   = return
   , appAttrMap      = const attrs
   , appChooseCursor = showFirstCursor
   }
@@ -267,18 +267,18 @@ app attrs dimAttrs =
 defaultAttributes :: Bool -> AttrMap
 defaultAttributes no_color = attrMap
   Vty.defAttr
-  [ (attrName "active"       , Vty.defAttr `withBackColor` Vty.blue)
-  , (attrName "not-installed", Vty.defAttr `withForeColor` Vty.red)
-  , (attrName "set"          , Vty.defAttr `withForeColor` Vty.green)
-  , (attrName "installed"    , Vty.defAttr `withForeColor` Vty.green)
-  , (attrName "recommended"  , Vty.defAttr `withForeColor` Vty.green)
-  , (attrName "hls-powered"  , Vty.defAttr `withForeColor` Vty.green)
-  , (attrName "latest"       , Vty.defAttr `withForeColor` Vty.yellow)
-  , (attrName "prerelease"   , Vty.defAttr `withForeColor` Vty.red)
-  , (attrName "compiled"     , Vty.defAttr `withForeColor` Vty.blue)
-  , (attrName "stray"        , Vty.defAttr `withForeColor` Vty.blue)
-  , (attrName "help"         , Vty.defAttr `withStyle`     Vty.italic)
-  , (attrName "hooray"       , Vty.defAttr `withForeColor` Vty.brightWhite)
+  [ ("active"       , Vty.defAttr `withBackColor` Vty.blue)
+  , ("not-installed", Vty.defAttr `withForeColor` Vty.red)
+  , ("set"          , Vty.defAttr `withForeColor` Vty.green)
+  , ("installed"    , Vty.defAttr `withForeColor` Vty.green)
+  , ("recommended"  , Vty.defAttr `withForeColor` Vty.green)
+  , ("hls-powered"  , Vty.defAttr `withForeColor` Vty.green)
+  , ("latest"       , Vty.defAttr `withForeColor` Vty.yellow)
+  , ("prerelease"   , Vty.defAttr `withForeColor` Vty.red)
+  , ("compiled"     , Vty.defAttr `withForeColor` Vty.blue)
+  , ("stray"        , Vty.defAttr `withForeColor` Vty.blue)
+  , ("help"         , Vty.defAttr `withStyle`     Vty.italic)
+  , ("hooray"       , Vty.defAttr `withForeColor` Vty.brightWhite)
   ]
   where
     withForeColor | no_color  = const
@@ -292,31 +292,31 @@ defaultAttributes no_color = attrMap
 dimAttributes :: Bool -> AttrMap
 dimAttributes no_color = attrMap
   (Vty.defAttr `Vty.withStyle` Vty.dim)
-  [ (attrName "active"    , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
-  , (attrName "no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
+  [ ("active"    , Vty.defAttr `withBackColor` Vty.blue) -- has no effect ??
+  , ("no-bindist", Vty.defAttr `Vty.withStyle` Vty.dim)
   ]
   where
     withBackColor | no_color  = \attr _ -> attr `Vty.withStyle` Vty.reverseVideo
                   | otherwise = Vty.withBackColor
 
-eventHandler :: BrickState -> BrickEvent String e -> EventM String BrickState ()
+eventHandler :: BrickState -> BrickEvent n e -> EventM n (Next BrickState)
 eventHandler st@BrickState{..} ev = do
   AppState { keyBindings = kb } <- liftIO $ readIORef settings'
   case ev of
     (MouseDown _ Vty.BScrollUp _ _) ->
-      put (BrickState { appState = moveCursor 1 appState Up, .. })
+      continue (BrickState { appState = moveCursor 1 appState Up, .. })
     (MouseDown _ Vty.BScrollDown _ _) ->
-      put (BrickState { appState = moveCursor 1 appState Down, .. })
-    (VtyEvent (Vty.EvResize _ _)) -> put st
+      continue (BrickState { appState = moveCursor 1 appState Down, .. })
+    (VtyEvent (Vty.EvResize _ _)) -> continue st
     (VtyEvent (Vty.EvKey Vty.KUp _)) ->
-      put BrickState{ appState = moveCursor 1 appState Up, .. }
+      continue BrickState{ appState = moveCursor 1 appState Up, .. }
     (VtyEvent (Vty.EvKey Vty.KDown _)) ->
-      put BrickState{ appState = moveCursor 1 appState Down, .. }
+      continue BrickState{ appState = moveCursor 1 appState Down, .. }
     (VtyEvent (Vty.EvKey key _)) ->
       case find (\(key', _, _) -> key' == key) (keyHandlers kb) of
-        Nothing -> put st
+        Nothing -> continue st
         Just (_, _, handler) -> handler st
-    _ -> put st
+    _ -> continue st
 
 
 moveCursor :: Int -> BrickInternalState -> Direction -> BrickInternalState
@@ -329,14 +329,13 @@ moveCursor steps ais@BrickInternalState{..} direction =
 
 -- | Suspend the current UI and run an IO action in terminal. If the
 -- IO action returns a Left value, then it's thrown as userError.
-withIOAction :: Ord n
-             => (BrickState
+withIOAction :: (BrickState
                  -> (Int, ListResult)
                  -> ReaderT AppState IO (Either String a))
              -> BrickState
-             -> EventM n BrickState ()
+             -> EventM n (Next BrickState)
 withIOAction action as = case listSelectedElement' (appState as) of
-  Nothing      -> put as
+  Nothing      -> continue as
   Just (ix, e) -> do
     suspendAndResume $ do
       settings <- readIORef settings'

app/ghcup/GHCup/OptParse.hs

@@ -8,7 +8,6 @@
 module GHCup.OptParse (
     module GHCup.OptParse.Common
   , module GHCup.OptParse.Install
-  , module GHCup.OptParse.Test
   , module GHCup.OptParse.Set
   , module GHCup.OptParse.UnSet
   , module GHCup.OptParse.Rm
@@ -32,7 +31,6 @@ module GHCup.OptParse (
 
 import           GHCup.OptParse.Common
 import           GHCup.OptParse.Install
-import           GHCup.OptParse.Test
 import           GHCup.OptParse.Set
 import           GHCup.OptParse.UnSet
 import           GHCup.OptParse.Rm
@@ -89,7 +87,6 @@ data Options = Options
 
 data Command
   = Install (Either InstallCommand InstallOptions)
-  | Test TestCommand
   | InstallCabalLegacy InstallOptions
   | Set (Either SetCommand SetOptions)
   | UnSet UnsetCommand
@@ -107,6 +104,9 @@ data Command
   | Nuke
 #if defined(BRICK)
   | Interactive
+#endif
+#if defined(ANSI)
+  | InteractiveAnsi
 #endif
   | Prefetch PrefetchCommand
   | GC GCOptions
@@ -187,8 +187,19 @@ opts =
 com :: Parser Command
 com =
   subparser
-#if defined(BRICK)
+#if defined(ANSI)
       (  command
+          "tui-ansi"
+          (   (\_ -> InteractiveAnsi)
+          <$> info
+                helper
+                (  progDesc "Start the interactive GHCup UI (ansi)"
+                )
+          )
+          <>
+#endif
+#if defined(BRICK)
+        command
           "tui"
           (   (\_ -> Interactive)
           <$> info
@@ -198,7 +209,7 @@ com =
           )
       <>  command
 #else
-      (  command
+          command
 #endif
           "install"
           (   Install
@@ -208,14 +219,6 @@ com =
                 <> footerDoc (Just $ text installToolFooter)
                 )
           )
-      <> command
-           "test"
-           (info
-             (Test <$> testParser <**> helper)
-             (  progDesc "Run tests for a tool (if any) [EXPERIMENTAL!]"
-             <> footerDoc (Just $ text testFooter)
-             )
-           )
       <> command
            "set"
            (info

app/ghcup/GHCup/OptParse/Config.hs

@@ -51,7 +51,7 @@ data ConfigCommand
   = ShowConfig
   | SetConfig String (Maybe String)
   | InitConfig
-  | AddReleaseChannel Bool URI
+  | AddReleaseChannel URI
 
 
 
@@ -74,7 +74,7 @@ configP = subparser
   showP = info (pure ShowConfig) (progDesc "Show current config (default)")
   setP  = info argsP (progDesc "Set config KEY to VALUE (or specify as single json value)" <> footerDoc (Just $ text configSetFooter))
   argsP = SetConfig <$> argument str (metavar "<JSON_VALUE | YAML_KEY>") <*> optional (argument str (metavar "YAML_VALUE"))
-  addP  = info (AddReleaseChannel <$> switch (long "force" <> help "Delete existing entry (if any) and append instead of failing") <*> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
+  addP  = info (AddReleaseChannel <$> argument (eitherReader uriParser) (metavar "URI" <> completer fileUri))
     (progDesc "Add a release channel from a URI")
 
 
@@ -120,38 +120,20 @@ formatConfig :: UserSettings -> String
 formatConfig = UTF8.toString . Y.encode
 
 
-updateSettings :: UserSettings -> UserSettings -> UserSettings
-updateSettings usl usr =
-   let cache'      = uCache usl      <|> uCache usr
-       metaCache'  = uMetaCache usl  <|> uMetaCache usr
-       metaMode'   = uMetaMode usl   <|> uMetaMode usr
-       noVerify'   = uNoVerify usl   <|> uNoVerify usr
-       verbose'    = uVerbose usl    <|> uVerbose usr
-       keepDirs'   = uKeepDirs usl   <|> uKeepDirs usr
-       downloader' = uDownloader usl <|> uDownloader usr
-       urlSource'  = uUrlSource usl  <|> uUrlSource usr
-       noNetwork'  = uNoNetwork usl  <|> uNoNetwork usr
-       gpgSetting' = uGPGSetting usl <|> uGPGSetting usr
-       platformOverride' = uPlatformOverride usl <|> uPlatformOverride usr
-       mirrors' = uMirrors usl <|> uMirrors usr
-   in UserSettings cache' metaCache' metaMode' noVerify' verbose' keepDirs' downloader' (updateKeyBindings (uKeyBindings usl) (uKeyBindings usr)) urlSource' noNetwork' gpgSetting' platformOverride' mirrors'
- where
-  updateKeyBindings :: Maybe UserKeyBindings -> Maybe UserKeyBindings -> Maybe UserKeyBindings
-  updateKeyBindings Nothing Nothing = Nothing
-  updateKeyBindings (Just kbl) Nothing = Just kbl
-  updateKeyBindings Nothing (Just kbr) = Just kbr
-  updateKeyBindings (Just kbl) (Just kbr) =
-       Just $ UserKeyBindings {
-           kUp = kUp kbl <|> kUp kbr
-         , kDown = kDown kbl <|> kDown kbr
-         , kQuit = kQuit kbl <|> kQuit kbr
-         , kInstall = kInstall kbl <|> kInstall kbr
-         , kUninstall = kUninstall kbl <|> kUninstall kbr
-         , kSet = kSet kbl <|> kSet kbr
-         , kChangelog = kChangelog kbl <|> kChangelog kbr
-         , kShowAll = kShowAll kbl <|> kShowAll kbr
-         , kShowAllTools = kShowAllTools kbl <|> kShowAllTools kbr
-         }
+updateSettings :: UserSettings -> Settings -> Settings
+updateSettings UserSettings{..} Settings{..} =
+   let cache'      = fromMaybe cache uCache
+       metaCache'  = fromMaybe metaCache uMetaCache
+       metaMode'   = fromMaybe metaMode uMetaMode
+       noVerify'   = fromMaybe noVerify uNoVerify
+       keepDirs'   = fromMaybe keepDirs uKeepDirs
+       downloader' = fromMaybe downloader uDownloader
+       verbose'    = fromMaybe verbose uVerbose
+       urlSource'  = fromMaybe urlSource uUrlSource
+       noNetwork'  = fromMaybe noNetwork uNoNetwork
+       gpgSetting' = fromMaybe gpgSetting uGPGSetting
+       platformOverride' = uPlatformOverride <|> platformOverride
+   in Settings cache' metaCache' metaMode' noVerify' keepDirs' downloader' verbose' urlSource' noNetwork' gpgSetting' noColor platformOverride'
 
 
 
@@ -159,9 +141,6 @@ updateSettings usl usr =
     --[ Entrypoint ]--
     ------------------
 
-data Duplicate = Duplicate     -- ^ there is a duplicate somewhere in the middle
-               | NoDuplicate   -- ^ there is no duplicate
-               | DuplicateLast -- ^ there's a duplicate, but it's the last element
 
 
 config :: forall m. ( Monad m
@@ -171,11 +150,10 @@ config :: forall m. ( Monad m
           )
      => ConfigCommand
      -> Settings
-     -> UserSettings
      -> KeyBindings
      -> (ReaderT LeanAppState m () -> m ())
      -> m ExitCode
-config configCommand settings userConf keybindings runLogger = case configCommand of
+config configCommand settings keybindings runLogger = case configCommand of
   InitConfig -> do
     path <- getConfigFilePath
     liftIO $ writeFile path $ formatConfig $ fromSettings settings (Just keybindings)
@@ -206,55 +184,27 @@ config configCommand settings userConf keybindings runLogger = case configComman
         pure $ ExitFailure 65
       VLeft _ -> pure $ ExitFailure 65
 
-  AddReleaseChannel force uri -> do
-    r <- runE @'[DuplicateReleaseChannel] $ do
-      case urlSource settings of
-        AddSource xs -> do
-          case checkDuplicate xs (Right uri) of
-            Duplicate
-              | not force -> throwE (DuplicateReleaseChannel uri)
-            DuplicateLast -> pure ()
-            _ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (appendUnique xs (Right uri)) })
-        GHCupURL -> do
-          lift $ doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
-          pure ()
-        OwnSource xs -> do
-          case checkDuplicate xs (Right uri) of
-            Duplicate
-              | not force -> throwE (DuplicateReleaseChannel uri)
-            DuplicateLast -> pure ()
-            _ -> lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (appendUnique xs (Right uri)) })
-        OwnSpec spec -> do
-          lift $ doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource [Left spec, Right uri] })
-          pure ()
-    case r of
-      VRight _ -> do
+  AddReleaseChannel uri -> do
+    case urlSource settings of
+      AddSource xs -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ AddSource (xs <> [Right uri]) })
+        pure ExitSuccess
+      GHCupURL -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ AddSource [Right uri] })
+        pure ExitSuccess
+      OwnSource xs -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource (xs <> [Right uri]) })
+        pure ExitSuccess
+      OwnSpec spec -> do
+        doConfig (defaultUserSettings { uUrlSource = Just $ OwnSource ([Left spec, Right uri]) })
         pure ExitSuccess
-      VLeft e -> do
-        runLogger $ logError $ T.pack $ prettyHFError e
-        pure $ ExitFailure 15
 
  where
-  checkDuplicate :: Eq a => [a] -> a -> Duplicate
-  checkDuplicate xs a
-    | last xs == a = DuplicateLast
-    | a `elem` xs  = Duplicate
-    | otherwise    = NoDuplicate
-
-  -- appends the element to the end of the list, but also removes it from the existing list
-  appendUnique :: Eq a => [a] -> a -> [a]
-  appendUnique xs' e = go xs'
-   where
-    go [] = [e]
-    go (x:xs)
-      | x == e    =     go xs -- skip
-      | otherwise = x : go xs
-
   doConfig :: MonadIO m => UserSettings -> m ()
   doConfig usersettings = do
-    let settings' = updateSettings usersettings userConf
+    let settings' = updateSettings usersettings settings
     path <- liftIO getConfigFilePath
-    liftIO $ writeFile path $ formatConfig $ settings'
+    liftIO $ writeFile path $ formatConfig $ fromSettings settings' (Just keybindings)
     runLogger $ logDebug $ T.pack $ show settings'
     pure ()
 

app/ghcup/GHCup/OptParse/List.hs

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

app/ghcup/GHCup/OptParse/Run.hs

@@ -254,7 +254,7 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
                liftIO $ putStr tmp
                pure ExitSuccess
              (cmd:args) -> do
-               newEnv <- liftIO $ addToPath tmp runAppendPATH
+               newEnv <- liftIO $ addToPath tmp
 #ifndef IS_WINDOWS
                void $ liftIO $ SPP.executeFile cmd True args (Just newEnv)
                pure ExitSuccess
@@ -441,6 +441,17 @@ run RunOptions{..} runAppState leanAppstate runLogger = do
             liftE $ setHLS v SetHLS_XYZ (Just tmp)
             liftE $ setHLS v SetHLSOnly (Just tmp)
 
+   addToPath path = do
+    cEnv <- Map.fromList <$> getEnvironment
+    let paths          = ["PATH", "Path"]
+        curPaths       = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
+        newPath        = intercalate [searchPathSeparator] (if runAppendPATH then (curPaths ++ [path]) else (path : curPaths))
+        envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
+        pathVar        = if isWindows then "Path" else "PATH"
+        envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
+    liftIO $ setEnv pathVar newPath
+    return envWithNewPath
+
    createTmpDir :: ( MonadUnliftIO m
                    , MonadCatch m
                    , MonadThrow m

app/ghcup/GHCup/OptParse/Set.hs

@@ -259,7 +259,7 @@ set :: forall m env.
         -> m (VEither eff GHCTargetVersion))
     -> (ReaderT LeanAppState m () -> m ())
     -> m ExitCode
-set setCommand runAppState _ runLogger = case setCommand of
+set setCommand runAppState runLeanAppState runLogger = case setCommand of
   (Right sopts) -> do
     runLogger (logWarn "This is an old-style command for setting GHC. Use 'ghcup set ghc' instead.")
     setGHC' sopts
@@ -271,7 +271,10 @@ set setCommand runAppState _ runLogger = case setCommand of
  where
   setGHC' :: SetOptions
           -> m ExitCode
-  setGHC' SetOptions{ sToolVer } = runSetGHC runAppState (do
+  setGHC' SetOptions{ sToolVer } =
+    case sToolVer of
+      (SetGHCVersion v) -> runSetGHC runLeanAppState (liftE $ setGHC v SetGHCOnly Nothing >> pure v)
+      _ -> runSetGHC runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer GHC
           liftE $ setGHC v SetGHCOnly Nothing
         )
@@ -288,7 +291,10 @@ set setCommand runAppState _ runLogger = case setCommand of
 
   setCabal' :: SetOptions
             -> m ExitCode
-  setCabal' SetOptions{ sToolVer } = runSetCabal runAppState (do
+  setCabal' SetOptions{ sToolVer } =
+    case sToolVer of
+      (SetToolVersion v) -> runSetCabal runLeanAppState (liftE $ setCabal v >> pure (mkTVer v))
+      _ -> runSetCabal runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer Cabal
           liftE $ setCabal (_tvVersion v)
           pure v
@@ -305,7 +311,10 @@ set setCommand runAppState _ runLogger = case setCommand of
 
   setHLS' :: SetOptions
           -> m ExitCode
-  setHLS' SetOptions{ sToolVer } = runSetHLS runAppState (do
+  setHLS' SetOptions{ sToolVer } =
+    case sToolVer of
+      (SetToolVersion v) -> runSetHLS runLeanAppState (liftE $ setHLS v SetHLSOnly Nothing >> pure (mkTVer v))
+      _ -> runSetHLS runAppState (do
           v <- liftE $ fst <$> fromVersion' sToolVer HLS
           liftE $ setHLS (_tvVersion v) SetHLSOnly Nothing
           pure v
@@ -323,7 +332,10 @@ set setCommand runAppState _ runLogger = case setCommand of
 
   setStack' :: SetOptions
             -> m ExitCode
-  setStack' SetOptions{ sToolVer } = runSetStack runAppState (do
+  setStack' SetOptions{ sToolVer } =
+    case sToolVer of
+      (SetToolVersion v) -> runSetStack runLeanAppState (liftE $ setStack v >> pure (mkTVer v))
+      _ -> runSetStack runAppState (do
             v <- liftE $ fst <$> fromVersion' sToolVer Stack
             liftE $ setStack (_tvVersion v)
             pure v

app/ghcup/GHCup/OptParse/Test.hs

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

app/ghcup/Main.hs

@@ -13,6 +13,9 @@ module Main where
 #if defined(BRICK)
 import           BrickMain                    ( brickMain )
 #endif
+#if defined(ANSI)
+import           AnsiMain                     ( ansiMain )
+#endif
 
 import qualified GHCup.GHC as GHC
 import qualified GHCup.HLS as HLS
@@ -63,7 +66,7 @@ import qualified GHCup.Types                   as Types
 
 
 
-toSettings :: Options -> IO (Settings, KeyBindings, UserSettings)
+toSettings :: Options -> IO (Settings, KeyBindings)
 toSettings options = do
   noColor <- isJust <$> lookupEnv "NO_COLOR"
   userConf <- runE @'[ JSONError ] ghcupConfigFile >>= \case
@@ -73,7 +76,7 @@ toSettings options = do
       pure defaultUserSettings
     _ -> do
       die "Unexpected error!"
-  pure $ (\(s', k) -> (s', k, userConf)) $ mergeConf options userConf noColor
+  pure $ mergeConf options userConf noColor
  where
    mergeConf :: Options -> UserSettings -> Bool -> (Settings, KeyBindings)
    mergeConf Options{..} UserSettings{..} noColor =
@@ -89,7 +92,6 @@ toSettings options = do
          noNetwork   = fromMaybe (fromMaybe (Types.noNetwork defaultSettings) uNoNetwork) optNoNetwork
          gpgSetting  = fromMaybe (fromMaybe (Types.gpgSetting defaultSettings) uGPGSetting) optGpg
          platformOverride = optPlatform <|> (uPlatformOverride <|> Types.platformOverride defaultSettings)
-         mirrors  = fromMaybe (Types.mirrors defaultSettings) uMirrors
      in (Settings {..}, keyBindings)
 #if defined(INTERNAL_DOWNLOADER)
    defaultDownloader = Internal
@@ -176,7 +178,7 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
           -- create ~/.ghcup dir
           ensureDirectories dirs
 
-          (settings, keybindings, userConf) <- toSettings opt
+          (settings, keybindings) <- toSettings opt
 
           -- logger interpreter
           logfile <- runReaderT initGHCupFileLogging dirs
@@ -235,6 +237,9 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
                   UnSet _ -> pure ()
 #if defined(BRICK)
                   Interactive -> pure ()
+#endif
+#if defined(ANSI)
+                  InteractiveAnsi -> pure ()
 #endif
                   -- check for new tools
                   _
@@ -293,17 +298,21 @@ Report bugs at <https://github.com/haskell/ghcup-hs/issues>|]
             Interactive -> do
               s' <- appState
               liftIO $ brickMain s' >> pure ExitSuccess
+#endif
+#if defined(ANSI)
+            InteractiveAnsi -> do
+              s' <- appState
+              liftIO $ ansiMain s' >> pure ExitSuccess
 #endif
             Install installCommand     -> install installCommand settings appState runLogger
             InstallCabalLegacy iopts   -> install (Left (InstallCabal iopts)) settings appState runLogger
-            Test testCommand           -> test testCommand settings appState runLogger
             Set setCommand             -> set setCommand runAppState runLeanAppState runLogger
             UnSet unsetCommand         -> unset unsetCommand runLeanAppState runLogger
             List lo                    -> list lo no_color runAppState
             Rm rmCommand               -> rm rmCommand runAppState runLogger
             DInfo                      -> dinfo runAppState runLogger
             Compile compileCommand     -> compile compileCommand settings dirs runAppState runLogger
-            Config configCommand       -> config configCommand settings userConf keybindings runLogger
+            Config configCommand       -> config configCommand settings keybindings runLogger
             Whereis whereisOptions
                     whereisCommand     -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
             Upgrade uOpts force' fatal -> upgrade uOpts force' fatal dirs runAppState runLogger

cabal.ghc8107.project

@@ -5,10 +5,17 @@ optional-packages: ./vendored/*/*.cabal
 optimization: 2
 
 package ghcup
+    tests: True
     flags: +tui
 
+source-repository-package
+  type: git
+  location: https://github.com/bgamari/terminal-size.git
+  tag: 34ea816bd63f75f800eedac12c6908c6f3736036
+
 constraints: http-io-streams -brotli,
-             any.aeson >= 2.0.1.0
+             any.Cabal ==3.6.2.0,
+             any.aeson >= 2.0.1.0,
 
 package libarchive
   flags: -system-libarchive
@@ -25,5 +32,6 @@ package aeson
 package streamly
   flags: +use-unliftio
 
+allow-newer: base, ghc-prim, template-haskell, language-c
 
 with-compiler: ghc-8.10.7

cabal.ghc8107.project.freeze

@@ -1,9 +1,8 @@
 active-repositories: hackage.haskell.org:merge
-constraints: any.Cabal ==3.6.3.0,
+constraints: any.Cabal ==3.6.2.0,
              Cabal -bundled-binary-generic,
-             any.Cabal-syntax ==3.8.1.0,
              any.HUnit ==1.6.2.0,
-             any.HsOpenSSL ==0.11.7.4,
+             any.HsOpenSSL ==0.11.7.2,
              HsOpenSSL -fast-bignum -homebrew-openssl -macports-openssl -use-pkg-config,
              any.OneTuple ==0.3.1,
              any.QuickCheck ==2.14.2,
@@ -11,13 +10,13 @@ constraints: any.Cabal ==3.6.3.0,
              any.StateVar ==1.2.2,
              any.abstract-deque ==0.3,
              abstract-deque -usecas,
-             any.aeson ==2.1.1.0,
+             any.aeson ==2.0.3.0,
              aeson -cffi +ordered-keymap,
              any.aeson-pretty ==0.8.9,
              aeson-pretty +lib-only,
              any.alex ==3.2.7.1,
-             any.ansi-terminal ==0.11.4,
-             ansi-terminal -example +win32-2-13-1,
+             any.ansi-terminal ==0.11.3,
+             ansi-terminal -example,
              any.ansi-wl-pprint ==0.6.9,
              ansi-wl-pprint -example,
              any.array ==0.5.4.0,
@@ -29,27 +28,23 @@ constraints: any.Cabal ==3.6.3.0,
              any.attoparsec ==0.14.4,
              attoparsec -developer,
              any.base ==4.14.3.0,
-             any.base-compat ==0.12.2,
-             any.base-compat-batteries ==0.12.2,
-             any.base-orphans ==0.8.7,
+             any.base-compat ==0.12.1,
+             any.base-compat-batteries ==0.12.1,
+             any.base-orphans ==0.8.6,
              any.base16-bytestring ==1.0.2.0,
              any.base64-bytestring ==1.2.1.0,
-             any.bifunctors ==5.5.14,
+             any.bifunctors ==5.5.12,
              bifunctors +semigroups +tagged,
-             any.bimap ==0.5.0,
              any.binary ==0.8.8.0,
-             any.binary-instances ==1.0.3,
-             any.binary-orphans ==1.0.3,
              any.blaze-builder ==0.4.2.2,
-             any.brick ==1.5,
+             any.brick ==0.64.2,
              brick -demos,
              any.bytestring ==0.10.12.0,
              any.bz2 ==1.0.1.0,
              bz2 -cross +with-bzlib,
              any.c2hs ==0.28.8,
              c2hs +base3 -regression,
-             any.cabal-install-parsers ==0.5,
-             any.cabal-plan ==0.7.2.3,
+             any.cabal-plan ==0.7.2.1,
              cabal-plan -_ -exe -license-report,
              any.call-stack ==0.4.0,
              any.case-insensitive ==1.2.1.0,
@@ -57,12 +52,14 @@ constraints: any.Cabal ==3.6.3.0,
              any.chs-cabal ==0.1.1.1,
              any.chs-deps ==0.1.0.0,
              chs-deps -cross,
+             any.clock ==0.8.3,
+             clock -llvm,
              any.colour ==2.3.6,
              any.comonad ==5.0.8,
              comonad +containers +distributive +indexed-traversable,
              any.composition-prelude ==3.0.0.2,
              composition-prelude -development,
-             any.config-ini ==0.2.5.0,
+             any.config-ini ==0.2.4.0,
              config-ini -enable-doctests,
              any.containers ==0.6.5.1,
              any.contravariant ==1.5.5,
@@ -72,7 +69,6 @@ constraints: any.Cabal ==3.6.3.0,
              any.cryptohash-sha1 ==0.11.101.0,
              any.cryptohash-sha256 ==0.11.102.1,
              cryptohash-sha256 -exe +use-cbits,
-             any.data-array-byte ==0.1.0.1,
              any.data-clist ==0.2,
              any.data-fix ==0.3.2,
              any.deepseq ==1.4.4.0,
@@ -84,57 +80,58 @@ constraints: any.Cabal ==3.6.3.0,
              dlist -werror,
              any.exceptions ==0.10.4,
              any.filepath ==1.4.2.1,
-             any.free ==5.1.10,
+             any.free ==5.1.8,
              any.fusion-plugin-types ==0.1.0,
              any.generic-arbitrary ==0.2.2,
-             any.generically ==0.1,
+             any.ghc ==8.10.7,
+             any.ghc-boot ==8.10.7,
              any.ghc-boot-th ==8.10.7,
              any.ghc-byteorder ==4.11.0.0.10,
+             any.ghc-heap ==8.10.7,
              any.ghc-prim ==0.6.1,
+             any.ghci ==8.10.7,
              any.happy ==1.20.0,
-             any.hashable ==1.4.2.0,
-             hashable +integer-gmp -random-initial-seed,
-             any.haskell-lexer ==1.1.1,
+             any.hashable ==1.4.0.2,
+             hashable +containers +integer-gmp -random-initial-seed,
              any.haskus-utils-data ==1.4,
              any.haskus-utils-types ==1.5.1,
              any.haskus-utils-variant ==3.2.1,
              any.heaps ==0.4,
+             any.hpc ==0.6.1.0,
              any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
-             any.hspec ==2.10.8,
-             any.hspec-core ==2.10.8,
-             any.hspec-discover ==2.10.8,
+             any.hspec ==2.9.7,
+             any.hspec-core ==2.9.7,
+             any.hspec-discover ==2.9.7,
              any.hspec-expectations ==0.8.2,
              any.hspec-golden-aeson ==0.9.0.0,
              any.http-io-streams ==0.1.6.1,
              http-io-streams -brotli +fast-xor,
              any.indexed-profunctors ==0.1.1,
              any.indexed-traversable ==0.1.2,
-             any.indexed-traversable-instances ==0.1.1.1,
+             any.indexed-traversable-instances ==0.1.1,
              any.integer-gmp ==1.0.3.0,
              any.integer-logarithms ==1.0.3.1,
              integer-logarithms -check-bounds +integer-gmp,
-             any.io-streams ==1.5.2.2,
+             any.io-streams ==1.5.2.1,
              io-streams +network -nointeractivetests +zlib,
-             any.language-c ==0.9.2,
+             any.language-c ==0.9.1,
              language-c -allwarnings +iecfpextension +usebytestrings,
              any.libarchive ==3.0.3.2,
              libarchive -cross -low-memory +no-exe -system-libarchive,
              any.libyaml-streamly ==0.2.1,
              libyaml-streamly -no-unicode -system-libyaml,
-             any.lockfree-queue ==0.2.4,
-             any.lukko ==0.1.1.3,
-             lukko +ofd-locking,
-             any.lzma-static ==5.2.5.5,
+             any.lockfree-queue ==0.2.3.1,
+             any.lzma-static ==5.2.5.4,
              any.megaparsec ==9.2.1,
              megaparsec -dev,
-             any.microlens ==0.4.13.1,
-             any.microlens-mtl ==0.2.0.3,
-             any.microlens-th ==0.4.3.11,
+             any.microlens ==0.4.12.0,
+             any.microlens-mtl ==0.2.0.2,
+             any.microlens-th ==0.4.3.10,
              any.mtl ==2.2.2,
              any.network ==3.1.2.7,
              network -devel,
-             any.network-uri ==2.6.4.2,
+             any.network-uri ==2.6.4.1,
              any.openssl-streams ==1.2.3.0,
              any.optics ==0.4.2,
              any.optics-core ==0.4.1,
@@ -146,7 +143,7 @@ constraints: any.Cabal ==3.6.3.0,
              any.os-release ==1.0.2.1,
              os-release -devel,
              any.parallel ==3.2.2.0,
-             any.parsec ==3.1.16.1,
+             any.parsec ==3.1.14.0,
              any.parser-combinators ==1.3.0,
              parser-combinators -dev,
              any.polyparse ==1.13,
@@ -158,12 +155,12 @@ constraints: any.Cabal ==3.6.3.0,
              any.quickcheck-arbitrary-adt ==0.3.1.0,
              any.quickcheck-io ==0.2.0,
              any.random ==1.2.1.1,
-             any.recursion-schemes ==5.2.2.3,
+             any.recursion-schemes ==5.2.2.2,
              recursion-schemes +template-haskell,
              any.regex-base ==0.94.0.2,
              any.regex-posix ==0.96.0.1,
              regex-posix -_regex-posix-clib,
-             any.resourcet ==1.2.6,
+             any.resourcet ==1.2.5,
              any.retry ==0.8.1.2,
              retry -lib-werror,
              any.rts ==1.0.1,
@@ -176,11 +173,11 @@ constraints: any.Cabal ==3.6.3.0,
              any.semigroupoids ==5.3.7,
              semigroupoids +comonad +containers +contravariant +distributive +tagged +unordered-containers,
              any.setenv ==0.1.1.3,
-             any.split ==0.2.3.5,
+             any.split ==0.2.3.4,
              any.splitmix ==0.1.0.4,
              splitmix -optimised-mixer,
              any.stm ==2.5.0.1,
-             any.streamly ==0.8.3,
+             any.streamly ==0.8.2,
              streamly -debug -dev -fusion-plugin -has-llvm -inspection -limit-build-mem -no-fusion +opt -streamk -streamly-core -use-c-malloc +use-unliftio,
              any.strict ==0.4.0.1,
              strict +assoc,
@@ -188,24 +185,20 @@ constraints: any.Cabal ==3.6.3.0,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
              any.tagsoup ==0.14.8,
-             any.tar ==0.5.1.1,
-             tar -old-bytestring -old-time,
              any.template-haskell ==2.16.0.0,
              any.temporary ==1.3,
              any.terminal-progress-bar ==0.4.1,
-             any.terminal-size ==0.3.3,
+             any.terminal-size ==0.3.2.1,
              any.terminfo ==0.4.1.4,
-             any.text ==2.0.1,
-             text -developer +simdutf,
-             any.text-binary ==0.2.1.1,
+             any.text ==1.2.4.1,
              any.text-short ==0.1.5,
              text-short -asserts,
-             any.text-zipper ==0.12,
+             any.text-zipper ==0.11,
              any.tf-random ==0.5,
-             any.th-abstraction ==0.4.5.0,
-             any.th-compat ==0.1.4,
+             any.th-abstraction ==0.4.3.0,
+             any.th-compat ==0.1.3,
              any.th-lift ==0.8.2,
-             any.th-lift-instances ==0.1.20,
+             any.th-lift-instances ==0.1.19,
              any.these ==1.1.1.1,
              these +assoc,
              any.time ==1.9.3,
@@ -214,12 +207,12 @@ constraints: any.Cabal ==3.6.3.0,
              any.transformers ==0.5.6.2,
              any.transformers-base ==0.4.6,
              transformers-base +orphaninstances,
-             any.transformers-compat ==0.7.2,
+             any.transformers-compat ==0.7.1,
              transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
-             any.unicode-data ==0.3.1,
+             any.unicode-data ==0.3.0,
              unicode-data -ucd2haskell,
              any.unix ==2.7.2.2,
-             any.unix-bytestring ==0.3.7.8,
+             any.unix-bytestring ==0.3.7.7,
              any.unix-compat ==0.6,
              unix-compat -old-time,
              any.unliftio-core ==0.2.0.1,
@@ -231,9 +224,8 @@ constraints: any.Cabal ==3.6.3.0,
              any.uuid-types ==1.0.5,
              any.vector ==0.12.3.1,
              vector +boundschecks -internalchecks -unsafechecks -wall,
-             any.vector-binary-instances ==0.2.5.2,
-             any.versions ==5.0.4,
-             any.vty ==5.37,
+             any.versions ==5.0.3,
+             any.vty ==5.33,
              any.witherable ==0.4.2,
              any.word-wrap ==0.5,
              any.word8 ==0.1.3,
@@ -243,4 +235,4 @@ constraints: any.Cabal ==3.6.3.0,
              any.zlib ==0.6.3.0,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
              any.zlib-bindings ==0.1.1.5
-index-state: hackage.haskell.org 2023-01-12T04:22:48Z
+index-state: hackage.haskell.org 2022-06-04T19:47:01Z

cabal.ghc902.project

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

cabal.ghc902.project.freeze

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

cabal.ghc923.project

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

cabal.ghc923.project.freeze

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

cabal.project

@@ -2,11 +2,20 @@ packages: ./ghcup.cabal
 
 optional-packages: ./vendored/*/*.cabal
 
+optimization: 2
+
 package ghcup
-    flags: +tui
+    tests: True
+    flags: +tui-ansi
+
+source-repository-package
+  type: git
+  location: https://github.com/bgamari/terminal-size.git
+  tag: 34ea816bd63f75f800eedac12c6908c6f3736036
 
 constraints: http-io-streams -brotli,
-             any.aeson >= 2.0.1.0
+             any.Cabal ==3.6.2.0,
+             any.aeson >= 2.0.1.0,
 
 package libarchive
   flags: -system-libarchive
@@ -23,3 +32,4 @@ package aeson
 package streamly
   flags: +use-unliftio
 
+allow-newer: base, ghc-prim, template-haskell, language-c

cabal.project.freeze

@@ -1,2 +1,2 @@
 -- windows picks weird version
-constraints: any.hsc2hs ==0.68.8
+constraints: any.hsc2hs ==0.68.7

cabal.project.release

@@ -1,50 +0,0 @@
-packages: ./ghcup.cabal
-
-optional-packages: ./vendored/*/*.cabal
-
-optimization: 2
-
-if os(linux)
-  package ghcup
-    flags: +tui
-  if arch(x86_64) || arch(i386)
-    package *
-      ghc-options: -split-sections -optl-static
-elif os(darwin)
-  constraints: zlib +bundled-c-zlib,
-               lzma +static
-  package ghcup
-    flags: +tui
-elif os(mingw32)
-  constraints: zlib +bundled-c-zlib,
-               lzma +static,
-               text -simdutf
-  package ghcup
-    flags: -tui
-elif os(freebsd)
-  constraints: zlib +bundled-c-zlib,
-               zip +disable-zstd
-  package *
-    ghc-options: -split-sections -pgmc clang++14
-  package ghcup
-    flags: +tui
-
-constraints: http-io-streams -brotli,
-             any.aeson >= 2.0.1.0,
-             any.hsc2hs ==0.68.8
-
-package libarchive
-  flags: -system-libarchive
-
-package aeson-pretty
-  flags: +lib-only
-
-package cabal-plan
-  flags: -exe
-
-package aeson
-  flags: +ordered-keymap
-
-package streamly
-  flags: +use-unliftio
-

data/config.yaml

@@ -92,30 +92,3 @@ url-source:
 #     tag: Linux
 #   version: '18.04'
 platform-override: null
-
-# Support for mirrors. Currently there are 3 hosts you can mirror:
-#   - github.com (for stack and some older HLS versions)
-#   - raw.githubusercontent.com (for the yaml metadata)
-#   - downloads.haskell.org (for everything else)
-#
-# E.g. when we have 'https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml'
-# and the following mirror config
-#
-#  "raw.githubusercontent.com":
-#    authority:
-#      host: "mirror.sjtu.edu.cn"
-#    pathPrefix: "ghcup/yaml"
-#
-# Then the resulting url will be 'https://mirror.sjtu.edu.cn/ghcup/yaml/haskell/ghcup-metadata/master/ghcup-0.0.7.yaml'
-mirrors:
-  "github.com":
-    authority:
-      host: "mirror.sjtu.edu.cn"
-  "raw.githubusercontent.com":
-    authority:
-      host: "mirror.sjtu.edu.cn"
-    pathPrefix: "ghcup/yaml"
-  "downloads.haskell.org":
-    authority:
-      host: "mirror.sjtu.edu.cn"
-

docker/alpine32/Dockerfile

@@ -1,4 +1,4 @@
-FROM --platform=linux/i386 i386/alpine:3.12
+FROM i386/alpine:3.12
 
 ENV LANG C.UTF-8
 

docker/arm32v7/Dockerfile

@@ -54,7 +54,10 @@ ENV NO_COLOR=1
 RUN ghcup config set gpg-setting GPGStrict && \
 	ghcup --verbose install ghc   --isolate=/usr     --force ${GHC} && \
 	ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
-	ghcup gc -s -c -t
+	find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
+	rm -r "/usr/share/doc/ghc-${GHC}" && \
+	rm -rf /tmp/ghcup* && \
+	ghcup gc -p -s -c -t
 
 ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
 

docker/arm32v7/buster/Dockerfile

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

docker/arm64v8/Dockerfile

@@ -54,7 +54,10 @@ ENV NO_COLOR=1
 RUN ghcup config set gpg-setting GPGStrict && \
 	ghcup --verbose install ghc   --isolate=/usr     --force ${GHC} && \
 	ghcup --verbose install cabal --isolate=/usr/bin --force ${CABAL_INSTALL} && \
-	ghcup gc -s -c -t
+	find "/usr/lib/ghc-${GHC}/" \( -name "*_p.a" -o -name "*.p_hi" \) -type f -delete && \
+	rm -r "/usr/share/doc/ghc-${GHC}" && \
+	rm -rf /tmp/ghcup* && \
+	ghcup gc -p -s -c -t
 
 ENV PATH /root/.cabal/bin:/root/.ghcup/bin:/root/.local/bin:$PATH
 

docker/arm64v8/buster/Dockerfile

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

docker/arm64v8/buster/update_opt.sh

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

docker/arm64v8/focal/update_opt.sh

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

docs/guide.md

@@ -163,7 +163,6 @@ ghcup --url-source=https://some-url/ghcup-0.0.6.yaml list
 #### Known mirrors
 
 1. [https://mirror.sjtu.edu.cn/docs/ghcup](https://mirror.sjtu.edu.cn/docs/ghcup)
-2. [https://mirrors.ustc.edu.cn/help/ghcup.html](https://mirrors.ustc.edu.cn/help/ghcup.html)
 
 ### (Pre-)Release channels
 

docs/index.md

@@ -4,6 +4,10 @@ hide:
   - toc
 ---
 
+<link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/font-awesome/4.7.0/css/font-awesome.min.css">
+<script src="javascripts/extra.js"></script>
+
+
 <section class="index-ghcup-hero">
   <img alt="haskell logo" src="./haskell_logo.png" />
   <h1>GHCup</h1>
@@ -31,7 +35,7 @@ hide:
       <span>
       </span>
 	<div class="footer">
-		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
+		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
 	</div>
     </div>
 
@@ -47,7 +51,7 @@ hide:
         <button class="btn" onclick="copyToClipboardWin()" id="ghcup-windows-button"><i class="fa fa-copy"></i></button>
       </div>
 	<div class="footer">
-		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-installation">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
+		<a href="https://github.com/haskell/ghcup-hs/blob/master/scripts/bootstrap/bootstrap-haskell.ps1" target="_blank">What does this do?</a> <b>&nbsp;&middot;&nbsp;</b> <a href="https://www.haskell.org/ghcup/install/#manual-install">I don't like curl | sh</a> <div class="show-all-platforms"><b>&nbsp;&middot;&nbsp;</b> <a class="show-all-platforms-button" href="#">Show all platforms</a></div></p>
 	</div>
     </div>
 </section>
@@ -80,6 +84,9 @@ hide:
    </span>
 </p>
 
+<script type="text/javascript" src="javascripts/ghcup.js"></script>
+
+
 ----
 
 

docs/install.md

@@ -1,7 +1,7 @@
 # Installation
 
 GHCup makes it easy to install specific versions of GHC on GNU/Linux,
-macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./#supported-tools) from scratch.
+macOS (aka Darwin), FreeBSD and Windows and can also bootstrap a fresh [Haskell developer environment](./install/#supported-tools) from scratch.
 It follows the UNIX philosophy of [do one thing and do it well](https://en.wikipedia.org/wiki/Unix_philosophy#Do_One_Thing_and_Do_It_Well). Similar in scope to [rustup](https://github.com/rust-lang-nursery/rustup.rs), [pyenv](https://github.com/pyenv/pyenv) and [jenv](http://www.jenv.be).
 
 ## How to install
@@ -24,7 +24,7 @@ Set-ExecutionPolicy Bypass -Scope Process -Force;[System.Net.ServicePointManager
 
 There's also a [youtube video](https://www.youtube.com/watch?v=bB4fmQiUYPw) explaining installation on windows.
 
-If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-installation) and GPG verify the binaries.
+If you want to know what these scripts do, check out the [source code at the repository](https://github.com/haskell/ghcup-hs/tree/master/scripts/bootstrap). Advanced users may want to perform a [manual installation](#manual-install) and GPG verify the binaries.
 
 ### Which versions get installed?
 
@@ -240,8 +240,6 @@ Lower availability of bindists. Stack and HLS binaries are experimental.
 
 ## Manual installation
 
-### Unix
-
 Download the binary for your platform at [https://downloads.haskell.org/~ghcup/](https://downloads.haskell.org/~ghcup/)
 and place it into your `PATH` anywhere.
 
@@ -253,60 +251,6 @@ Then adjust your `PATH` in `~/.bashrc` (or similar, depending on your shell) lik
 export PATH="$HOME/.cabal/bin:$HOME/.ghcup/bin:$PATH"
 ```
 
-### Windows
-
-1. Install ghcup binary
-    - choose a base directory for installation, e.g. `C:\` that has sufficient space
-    - then create the directory, e.g. `C:\ghcup\bin`
-    - download the binary: https://downloads.haskell.org/~ghcup/x86_64-mingw64-ghcup.exe
-    - place it as `ghcup.exe` into e.g. `C:\ghcup\bin`
-2. Install MSYS2
-    - download https://repo.msys2.org/distrib/msys2-x86_64-latest.exe and execute it
-    - remember the installation destination you choose (default is `C:\msys64`)
-    - finish the installation
-* Add environment variables and update `Path`
-    - open search bar and type in "Edit the system environment variables", then open it
-    - click on "Environment Variables..." at the near bottom
-    - in the upper half, select `Path` variable and double click on it
-    - in the new window, click "New", type in `C:\ghcup\bin` (depending on step 1.) and press enter
-    - click "OK" at the bottom
-    - in the upper half, click on "New..."
-    - enter `GHCUP_MSYS2` under "Variable name" and the installation destination from step 2. under "Variable value"
-    - click "OK" at the bottom
-    - in the upper half, click on "New..."
-    - enter `GHCUP_INSTALL_BASE_PREFIX` under "Variable name" and based on the installation destination from step 1. enter the device directory (default `C:\`)
-    - click "OK" at the bottom
-    - in the upper half, click on "New..."
-    - enter `CABAL_DIR` under "Variable name" and based on the installation destination from step 1. enter the device directory + `cabal` subdir (default `C:\cabal`)
-    - click "OK" at the bottom
-    - click "OK" at the bottom
-    - click "OK" at the bottom
-3. Install tools
-    - open powershell
-    - run `ghcup install ghc --set recommended`
-    - run `ghcup install cabal latest`
-    - run `ghcup install stack latest`
-    - run `ghcup install hls latest`
-    - run `cabal update`
-4. Update msys2
-    - run `ghcup run -m -- pacman --noconfirm -Syuu`
-    - run `ghcup run -m -- pacman --noconfirm -Syuu`
-    - run `ghcup run -m -- pacman --noconfirm -S --needed curl autoconf mingw-w64-x86_64-pkgconf`
-    - run `ghcup run -m -- pacman --noconfirm -S ca-certificates`
-5. Update cabal config
-    - go to e.g. `C:\cabal` (based on device you picked in 1.)
-    - open file `config`
-    - uncomment `extra-include-dirs` (the `-- `) and add the value (depending on installation destination you chose in 2.), e.g. `C:\msys64\mingw64\include`... so the final line should be `extra-include-dirs: C:\msys64\mingw64\include`
-    - uncomment `extra-lib-dirs` and do the same, adding `C:\msys64\mingw64\lib`
-    - uncomment `extra-prog-path` and set it to `C:\ghcup\bin, C:\cabal\bin, C:\msys64\mingw64\bin, C:\msys64\usr\bin`, depending on your install destinations from 1. and 2.
-6. Set up msys2 shell
-    - run `ghcup run -m -- sed -i -e 's/db_home:.*$/db_home: windows/' /etc/nsswitch.conf` to make the HOME in your msys2 shell match the one from windows
-    - make a desktop shortcut from `C:\msys64\msys2_shell.cmd`, which will allow you to start a proper msys2 shell
-    - run `ghcup run -m -- sed -i -e 's/#MSYS2_PATH_TYPE=.*/MSYS2_PATH_TYPE=inherit/' /c/msys64/msys2.ini`
-    - run `ghcup run -m -- sed -i -e 's/rem set MSYS2_PATH_TYPE=inherit/set MSYS2_PATH_TYPE=inherit/' /c/msys64/msys2_shell.cmd`
-
-All set. You can run `cabal init` now in an empty directory to start a project.
-
 ## Vim integration
 
 See [ghcup.vim](https://github.com/hasufell/ghcup.vim).

docs/overrides/base.html

@@ -0,0 +1,201 @@
+<!DOCTYPE html>
+<html lang="{{ config.theme.locale|default('en') }}">
+    <head>
+      {%- block site_meta %}
+        <meta charset="utf-8">
+        <meta http-equiv="X-UA-Compatible" content="IE=edge">
+        <meta name="viewport" content="width=device-width, initial-scale=1.0">
+        {% if page and page.is_homepage %}<meta name="description" content="{{ config['site_description'] }}">{% endif %}
+        {% if config.site_author %}<meta name="author" content="{{ config.site_author }}">{% endif %}
+        {% if page and page.canonical_url %}<link rel="canonical" href="{{ page.canonical_url }}">{% endif %}
+        {% if config.site_favicon %}<link rel="shortcut icon" href="{{ config.site_favicon|url }}">
+        {% else %}<link rel="shortcut icon" href="{{ 'img/favicon.ico'|url }}">{% endif %}
+      {%- endblock %}
+
+      {%- block htmltitle %}
+        <title>{% if page and page.title and not page.is_homepage %}{{ page.title }} - {% endif %}{{ config.site_name }}</title>
+      {%- endblock %}
+
+      {%- block styles %}
+        <link href="{{ 'css/bootstrap.min.css'|url }}" rel="stylesheet">
+        <link href="{{ 'css/font-awesome.min.css'|url }}" rel="stylesheet">
+        <link href="{{ 'css/base.css'|url }}" rel="stylesheet">
+        {%- if config.theme.highlightjs %}
+        <link rel="stylesheet" href="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/styles/{{ config.theme.hljs_style }}.min.css">
+        {%- endif %}
+        {%- for path in extra_css %}
+        <link href="{{ path }}" rel="stylesheet">
+        {%- endfor %}
+      {%- endblock %}
+
+      {%- block libs %}
+
+        <script src="{{ 'js/jquery-1.10.2.min.js'|url }}" defer></script>
+        <script src="{{ 'js/bootstrap.min.js'|url }}" defer></script>
+        {%- if config.theme.highlightjs %}
+        <script src="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/highlight.min.js"></script>
+        {%- for lang in config.theme.hljs_languages %}
+        <script src="https://cdnjs.cloudflare.com/ajax/libs/highlight.js/10.5.0/languages/{{lang}}.min.js"></script>
+        {%- endfor %}
+        <script>hljs.initHighlightingOnLoad();</script>
+        {%- endif %}
+      {%- endblock %}
+
+      {%- block analytics %}
+        {%- if config.theme.analytics.gtag %}
+        <script async src="https://www.googletagmanager.com/gtag/js?id={{ config.theme.analytics.gtag }}"></script>
+        <script>
+          window.dataLayer = window.dataLayer || [];
+          function gtag(){dataLayer.push(arguments);}
+          gtag('js', new Date());
+
+          gtag('config', '{{ config.theme.analytics.gtag }}');
+        </script>
+        {%- elif config.google_analytics %}
+        <script>
+            (function(i,s,o,g,r,a,m){i['GoogleAnalyticsObject']=r;i[r]=i[r]||function(){
+            (i[r].q=i[r].q||[]).push(arguments)},i[r].l=1*new Date();a=s.createElement(o),
+            m=s.getElementsByTagName(o)[0];a.async=1;a.src=g;m.parentNode.insertBefore(a,m)
+            })(window,document,'script','https://www.google-analytics.com/analytics.js','ga');
+
+            ga('create', '{{ config.google_analytics[0] }}', '{{ config.google_analytics[1] }}');
+            ga('send', 'pageview');
+        </script>
+        {%- endif %}
+      {%- endblock %}
+
+      {%- block extrahead %} {% endblock %}
+    </head>
+
+    <body{% if page and page.is_homepage %} class="homepage"{% endif %}>
+        <div class="navbar fixed-top navbar-expand-lg navbar-{% if config.theme.nav_style == "light" %}light{% else %}dark{% endif %} bg-{{ config.theme.nav_style }}">
+            <div class="container">
+
+                {%- block site_name %}
+                <a class="navbar-brand" href="{{ nav.homepage.url|url }}">{{ config.site_name }}</a>
+                {%- endblock %}
+
+                {%- if nav|length>1 or (page and (page.next_page or page.previous_page)) or config.repo_url %}
+                <!-- Expander button -->
+                <button type="button" class="navbar-toggler" data-toggle="collapse" data-target="#navbar-collapse">
+                    <span class="navbar-toggler-icon"></span>
+                </button>
+                {%- endif %}
+
+                <!-- Expanded navigation -->
+                <div id="navbar-collapse" class="navbar-collapse collapse">
+                  {%- block site_nav %}
+                    {%- if nav|length>1 %}
+                        <!-- Main navigation -->
+                        <ul class="nav navbar-nav">
+                        {%- for nav_item in nav %}
+                        {%- if nav_item.children %}
+                            <li class="dropdown{% if nav_item.active %} active{% endif %}">
+                                <a href="#" class="nav-link dropdown-toggle" data-toggle="dropdown">{{ nav_item.title }} <b class="caret"></b></a>
+                                <ul class="dropdown-menu">
+                                {%- for nav_item in nav_item.children %}
+                                    {% include "nav-sub.html" %}
+                                {%- endfor %}
+                                </ul>
+                            </li>
+                        {%- else %}
+                            <li class="navitem{% if nav_item.active %} active{% endif %}">
+                                <a href="{{ nav_item.url|url }}" class="nav-link">{{ nav_item.title }}</a>
+                            </li>
+                        {%- endif %}
+                        {%- endfor %}
+                        </ul>
+                    {%- endif %}
+                  {%- endblock %}
+
+                    <ul class="nav navbar-nav ml-auto">
+                      {%- block search_button %}
+                        {%- if 'search' in config['plugins'] %}
+                        <li class="nav-item">
+                            <a href="#" class="nav-link" data-toggle="modal" data-target="#mkdocs_search_modal">
+                                <i class="fa fa-search"></i> {% trans %}Search{% endtrans %}
+                            </a>
+                        </li>
+                        {%- endif %}
+                      {%- endblock %}
+
+                      {%- block next_prev %}
+                      {%- endblock %}
+
+                      {%- block repo %}
+                        {%- if page and page.edit_url %}
+                            <li class="nav-item">
+                                <a href="{{ page.edit_url }}" class="nav-link">
+                                    {%- if config.repo_name == 'GitHub' -%}
+                                        <i class="fa fa-github"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
+                                    {%- elif config.repo_name == 'Bitbucket' -%}
+                                        <i class="fa fa-bitbucket"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
+                                    {%- elif config.repo_name == 'GitLab' -%}
+                                        <i class="fa fa-gitlab"></i> {% trans repo_name=config.repo_name %}Edit on {{ repo_name }}{% endtrans %}
+                                    {%- else -%}
+                                    {% trans repo_name=config.repo_name%}Edit on {{ repo_name }}{% endtrans %}
+                                    {%- endif -%}
+                                </a>
+                            </li>
+                        {%- elif config.repo_url %}
+                            <li class="nav-item">
+                                <a href="{{ config.repo_url }}" class="nav-link">
+                                    {%- if config.repo_name == 'GitHub' -%}
+                                        <i class="fa fa-github"></i> {{ config.repo_name }}
+                                    {%- elif config.repo_name == 'Bitbucket' -%}
+                                        <i class="fa fa-bitbucket"></i> {{ config.repo_name }}
+                                    {%- elif config.repo_name == 'GitLab' -%}
+                                        <i class="fa fa-gitlab"></i> {{ config.repo_name }}
+                                    {%- else -%}
+                                    {{ config.repo_name }}
+                                    {%- endif -%}
+                                </a>
+                            </li>
+                        {%- endif %}
+                      {%- endblock %}
+                    </ul>
+                </div>
+            </div>
+        </div>
+
+        <div class="container">
+            <div class="row">
+                {%- block content %}
+                    <div class="col-md-3">{% include "toc.html" %}</div>
+                    <div class="col-md-9" role="main">{% include "content.html" %}</div>
+                {%- endblock %}
+            </div>
+        </div>
+
+        <footer class="col-md-12">
+          {%- block footer %}
+            <hr>
+            {%- if config.copyright %}
+                <p>{{ config.copyright }}</p>
+            {%- endif %}
+            <p>{% trans mkdocs_link='<a href="https://www.mkdocs.org/">MkDocs</a>' %}Documentation built with {{ mkdocs_link }}.{% endtrans %}</p>
+          {%- endblock %}
+        </footer>
+
+      {%- block scripts %}
+        <script>
+            var base_url = {{ base_url | tojson }},
+                shortcuts = {{ config.theme.shortcuts | tojson }};
+        </script>
+        <script src="{{ 'js/base.js'|url }}" defer></script>
+        {%- for path in extra_javascript %}
+        <script src="{{ path }}" defer></script>
+        {%- endfor %}
+      {%- endblock %}
+
+        {% if 'search' in config['plugins'] %}{%- include "search-modal.html" %}{% endif %}
+        {%- include "keyboard-modal.html" %}
+
+    </body>
+</html>
+{% if page and page.is_homepage %}
+<!--
+MkDocs version : {{ mkdocs_version }}
+Build Date UTC : {{ build_date_utc }}
+-->
+{% endif %}

docs/overrides/main.html

@@ -1,4 +0,0 @@
-{% extends "base.html" %}
-<!-- Get rid of the next/prev buttons -->
-{% block next_prev %}
-{% endblock %}

ghcup.cabal

@@ -1,6 +1,6 @@
-cabal-version:      2.4
+cabal-version:      3.0
 name:               ghcup
-version:            0.1.19.1
+version:            0.1.18.1
 license:            LGPL-3.0-only
 license-file:       LICENSE
 copyright:          Julian Ospald 2020
@@ -25,10 +25,10 @@ extra-source-files:
   cbits/dirutils.h
   data/build_mk/cross
   data/build_mk/default
-  test/data/dir/.keep
-  test/data/file
   test/golden/unix/GHCupInfo.json
   test/golden/windows/GHCupInfo.json
+  test/data/file
+  test/data/dir/.keep
 
 source-repository head
   type:     git
@@ -41,6 +41,11 @@ flag tui
   default:     False
   manual:      True
 
+flag tui-ansi
+  description: Build the ansi-terminal powered tui (ghcup tui-ansi).
+  default:     False
+  manual:      True
+
 flag internal-downloader
   description:
     Compile the internal downloader, which links against OpenSSL. This is disabled on windows.
@@ -65,6 +70,7 @@ library
     GHCup.List
     GHCup.Platform
     GHCup.Prelude
+    GHCup.Prelude.Ansi
     GHCup.Prelude.File
     GHCup.Prelude.File.Search
     GHCup.Prelude.Internal
@@ -124,7 +130,7 @@ library
     , directory             ^>=1.3.6.0
     , disk-free-space       ^>=0.1.0.1
     , exceptions            ^>=0.10
-    , filepath              ^>=1.4.2.1
+    , filepath              ==1.4.2.1
     , haskus-utils-types    ^>=1.5
     , haskus-utils-variant  ^>=3.2.1
     , libarchive            ^>=3.0.3.0
@@ -143,9 +149,9 @@ library
     , split                 ^>=0.2.3.4
     , streamly              ^>=0.8.2
     , strict-base           ^>=0.4
-    , template-haskell      >=2.7        && <2.20
+    , template-haskell      >=2.7        && <2.18
     , temporary             ^>=1.3
-    , text                  ^>=2.0
+    , text                  ^>=1.2.4.0
     , time                  ^>=1.9.3
     , transformers          ^>=0.5
     , unliftio-core         ^>=0.2.0.1
@@ -161,7 +167,7 @@ library
     exposed-modules: GHCup.Download.IOStreams
     cpp-options:     -DINTERNAL_DOWNLOADER
     build-depends:
-      , HsOpenSSL              >=0.11.7.2
+      , HsOpenSSL              >=0.11.4.18
       , http-io-streams        >=0.1.2.0
       , io-streams             >=1.5.2.1
       , terminal-progress-bar  >=0.4.1
@@ -185,21 +191,22 @@ library
       GHCup.Prelude.File.Posix.Foreign
       GHCup.Prelude.Posix
       GHCup.Prelude.Process.Posix
+    exposed-modules:
+      GHCup.Prelude.File.Posix.Traversals
 
-    exposed-modules:  GHCup.Prelude.File.Posix.Traversals
     include-dirs:     cbits
     includes:         dirutils.h
     install-includes: dirutils.h
     c-sources:        cbits/dirutils.c
     build-depends:
       , bz2              >=0.5.0.5 && <1.1
-      , terminal-size    ^>=0.3.3
+      , terminal-size    ^>=0.3.2.1
       , unix             ^>=2.7
       , unix-bytestring  ^>=0.3.7.3
 
   if (flag(tui) && !os(windows))
     cpp-options:   -DBRICK
-    build-depends: vty ^>=5.37
+    build-depends: vty >=5.28.2 && <5.34
 
 executable ghcup
   main-is:            Main.hs
@@ -218,7 +225,6 @@ executable ghcup
     GHCup.OptParse.Rm
     GHCup.OptParse.Run
     GHCup.OptParse.Set
-    GHCup.OptParse.Test
     GHCup.OptParse.ToolRequirements
     GHCup.OptParse.UnSet
     GHCup.OptParse.Upgrade
@@ -241,52 +247,60 @@ executable ghcup
     -fwarn-incomplete-record-updates -threaded
 
   build-depends:
-    , aeson                  >=1.4
-    , aeson-pretty           ^>=0.8.8
-    , async                  ^>=2.2.3
-    , base                   >=4.12     && <5
-    , bytestring             >=0.10     && <0.12
-    , cabal-install-parsers  >=0.4.5
-    , cabal-plan             ^>=0.7.2
-    , containers             ^>=0.6
-    , deepseq                ^>=1.4
-    , directory              ^>=1.3.6.0
-    , filepath               ^>=1.4.2.1
+    , aeson                 >=1.4
+    , aeson-pretty          ^>=0.8.8
+    , async                 ^>=2.2.3
+    , base                  >=4.12     && <5
+    , bytestring            >=0.10     && <0.12
+    , cabal-plan            ^>=0.7.2
+    , cabal-install-parsers >=0.4.5
+    , containers            ^>=0.6
+    , deepseq               ^>=1.4
+    , directory             ^>=1.3.6.0
+    , filepath              ==1.4.2.1
     , ghcup
-    , haskus-utils-types     ^>=1.5
-    , haskus-utils-variant   ^>=3.2.1
-    , libarchive             ^>=3.0.3.0
-    , megaparsec             >=8.0.0    && <9.3
-    , mtl                    ^>=2.2
-    , optparse-applicative   >=0.15.1.0 && <0.18
-    , pretty                 ^>=1.1.3.1
-    , pretty-terminal        ^>=0.1.0.0
-    , process                ^>=1.6.11.0
-    , resourcet              ^>=1.2.2
-    , safe                   ^>=0.3.18
-    , safe-exceptions        ^>=0.1
-    , tagsoup                ^>=0.14
-    , template-haskell       >=2.7      && <2.20
-    , temporary              ^>=1.3
-    , text                   ^>=2.0
-    , unordered-containers   ^>=0.2
-    , uri-bytestring         ^>=0.3.2.2
-    , utf8-string            ^>=1.0
-    , vector                 ^>=0.12
-    , versions               >=4.0.1    && <5.1
-    , yaml-streamly          ^>=0.12.0
+    , haskus-utils-types    ^>=1.5
+    , haskus-utils-variant  ^>=3.2.1
+    , libarchive            ^>=3.0.3.0
+    , megaparsec            >=8.0.0    && <9.3
+    , mtl                   ^>=2.2
+    , optparse-applicative  >=0.15.1.0 && <0.18
+    , pretty                ^>=1.1.3.1
+    , pretty-terminal       ^>=0.1.0.0
+    , process               ^>=1.6.11.0
+    , resourcet             ^>=1.2.2
+    , safe                  ^>=0.3.18
+    , safe-exceptions       ^>=0.1
+    , tagsoup               ^>=0.14
+    , template-haskell      >=2.7      && <2.18
+    , temporary             ^>=1.3
+    , text                  ^>=1.2.4.0
+    , unordered-containers  ^>=0.2
+    , uri-bytestring        ^>=0.3.2.2
+    , utf8-string           ^>=1.0
+    , vector                ^>=0.12
+    , versions              >=4.0.1    && <5.1
+    , yaml-streamly         ^>=0.12.0
 
   if flag(internal-downloader)
     cpp-options: -DINTERNAL_DOWNLOADER
 
+  if flag(tui-ansi)
+    cpp-options:   -DANSI
+    other-modules: AnsiMain
+    build-depends:
+      , ansi-terminal
+      , ansi-terminal-game
+      , transformers        ^>=0.5
+
   if (flag(tui) && !os(windows))
     cpp-options:   -DBRICK
     other-modules: BrickMain
     build-depends:
-      , brick         ^>=1.5
+      , brick         ^>=0.64
       , transformers  ^>=0.5
       , unix          ^>=2.7
-      , vty           ^>=5.37
+      , vty           >=5.28.2 && <5.34
 
   if os(windows)
     cpp-options: -DIS_WINDOWS
@@ -304,9 +318,9 @@ test-suite ghcup-test
   hs-source-dirs:     test
   other-modules:
     GHCup.ArbitraryTypes
-    GHCup.Prelude.File.Posix.TraversalsSpec
     GHCup.Types.JSONSpec
     GHCup.Utils.FileSpec
+    GHCup.Prelude.File.Posix.TraversalsSpec
     Spec
 
   default-language:   Haskell2010
@@ -327,7 +341,7 @@ test-suite ghcup-test
     , bytestring                >=0.10    && <0.12
     , containers                ^>=0.6
     , directory                 ^>=1.3.6.0
-    , filepath                  ^>=1.4.2.1
+    , filepath                  ==1.4.2.1
     , generic-arbitrary         >=0.1.0   && <0.2.1 || >=0.2.2 && <0.3
     , ghcup
     , hspec                     >=2.7.10  && <2.11
@@ -335,12 +349,12 @@ test-suite ghcup-test
     , QuickCheck                ^>=2.14.1
     , quickcheck-arbitrary-adt  ^>=0.3.1.0
     , streamly                  ^>=0.8.2
-    , text                      ^>=2.0
+    , text                      ^>=1.2.4.0
     , uri-bytestring            ^>=0.3.2.2
     , versions                  >=4.0.1   && <5.1
 
   if os(windows)
     cpp-options: -DIS_WINDOWS
-
   else
-    build-depends: unix ^>=2.7
+    build-depends:
+      , unix             ^>=2.7

lib/GHCup/Download.hs

@@ -263,12 +263,8 @@ getBase uri = do
     dlWithMod modTime json_file = do
       let (dir, fn) = splitFileName json_file
       f <- liftE $ download uri' (Just $ over pathL' (<> ".sig") uri') Nothing Nothing dir (Just fn) True
-
-      -- make these failures non-fatal, also see:
-      -- https://github.com/actions/runner-images/issues/7061
-      handleIO (\e -> logWarn $ "setModificationTime failed with: " <> T.pack (displayException e)) $ liftIO $ setModificationTime f modTime
-      handleIO (\e -> logWarn $ "setAccessTime failed with: " <> T.pack (displayException e)) $ liftIO $ setAccessTime f modTime
-
+      liftIO $ setModificationTime f modTime
+      liftIO $ setAccessTime f modTime
       pure f
 
 
@@ -337,21 +333,19 @@ download :: ( MonadReader env m
          -> Maybe FilePath    -- ^ optional filename
          -> Bool              -- ^ whether to read an write etags
          -> Excepts '[DigestError, ContentLengthError, DownloadFailed, GPGError] m FilePath
-download rawUri gpgUri eDigest eCSize dest mfn etags
+download uri gpgUri eDigest eCSize dest mfn etags
   | scheme == "https" = liftE dl
   | scheme == "http"  = liftE dl
   | scheme == "file"  = do
-      let destFile' = T.unpack . decUTF8Safe $ view pathL' rawUri
+      let destFile' = T.unpack . decUTF8Safe $ view pathL' uri
       lift $ logDebug $ "using local file: " <> T.pack destFile'
       forM_ eDigest (liftE . flip checkDigest destFile')
       pure destFile'
   | otherwise = throwE $ DownloadFailed (variantFromValue UnsupportedScheme)
 
  where
-  scheme = view (uriSchemeL' % schemeBSL') rawUri
+  scheme = view (uriSchemeL' % schemeBSL') uri
   dl = do
-    Settings{ mirrors } <- lift getSettings
-    let uri = applyMirrors mirrors rawUri
     baseDestFile <- liftE . reThrowAll @_ @_ @'[DownloadFailed] DownloadFailed $ getDestFile uri mfn
     lift $ logInfo $ "downloading: " <> (decUTF8Safe . serializeURIRef') uri <> " as file " <> T.pack baseDestFile
 
@@ -757,17 +751,3 @@ getLastHeader = T.unlines . lastDef [] . filter (\x -> not (null x)) . splitOn [
 
 tmpFile :: FilePath -> FilePath
 tmpFile = (<.> "tmp")
-
-
-applyMirrors :: DownloadMirrors -> URI -> URI
-applyMirrors (DM ms) uri@(URI { uriAuthority = Just (Authority { authorityHost = Host host }) }) =
-  case M.lookup (decUTF8Safe host) ms of
-    Nothing -> uri
-    Just (DownloadMirror auth (Just prefix)) ->
-      uri { uriAuthority = Just auth
-          , uriPath = E.encodeUtf8 $ T.pack ("/" <> T.unpack prefix <> (T.unpack . decUTF8Safe . uriPath $ uri))
-          }
-    Just (DownloadMirror auth Nothing) ->
-      uri { uriAuthority = Just auth }
-applyMirrors _ uri = uri
-

lib/GHCup/Errors.hs

@@ -35,8 +35,6 @@ import           URI.ByteString
 
 import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
-import qualified Data.Text.Encoding            as E
-import qualified Data.Text.Encoding.Error      as E
 import           Data.Data (Proxy(..))
 
 
@@ -84,12 +82,10 @@ allHFError = unlines allErrors
     , let proxy = Proxy :: Proxy HadrianNotFound in format proxy
     , let proxy = Proxy :: Proxy ToolShadowed in format proxy
     , let proxy = Proxy :: Proxy ContentLengthError in format proxy
-    , let proxy = Proxy :: Proxy DuplicateReleaseChannel in format proxy
     , ""
-    , "# high level errors (4000+)"
+    , "# high level errors (5000+)"
     , let proxy = Proxy :: Proxy DownloadFailed in format proxy
     , let proxy = Proxy :: Proxy InstallSetError in format proxy
-    , let proxy = Proxy :: Proxy TestFailed in format proxy
     , let proxy = Proxy :: Proxy BuildFailed in format proxy
     , let proxy = Proxy :: Proxy GHCupSetError in format proxy
     , ""
@@ -165,6 +161,7 @@ prettyHFError e =
   let errorCode = "GHCup-" <> padIntAndShow (eNum e)
   in ("[" <> linkEscapeCode errorCode  (hfErrorLink errorCode) <> "] ") <> prettyShow e
  where
+  linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
   hfErrorLink errorCode = "https://errors.haskell.org/messages/" <> errorCode
   padIntAndShow i
     | i < 10    = "0000" <> show i
@@ -181,9 +178,6 @@ class HFErrorProject a where
 
   eDesc :: Proxy a -> String
 
-linkEscapeCode :: String -> String -> String
-linkEscapeCode linkText link = "\ESC]8;;" <> link <> "\ESC\\" <> linkText <> "\ESC]8;;\ESC\\"
-
 
     ------------------------
     --[ Low-level errors ]--
@@ -643,19 +637,6 @@ instance HFErrorProject ContentLengthError where
   eBase _ = 340
   eDesc _ = "File content length verification failed"
 
-data DuplicateReleaseChannel = DuplicateReleaseChannel URI
-  deriving Show
-
-instance HFErrorProject DuplicateReleaseChannel where
-  eBase _ = 350
-  eDesc _ = "Duplicate release channel detected when adding URI.\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
-
-instance Pretty DuplicateReleaseChannel where
-  pPrint (DuplicateReleaseChannel uri) =
-    text $ "Duplicate release channel detected when adding: \n  "
-      <> (T.unpack . E.decodeUtf8With E.lenientDecode . serializeURIRef') uri
-      <> "\nGiving up. You can use '--force' to remove and append the duplicate URI (this may change order/semantics)."
-
     -------------------------
     --[ High-level errors ]--
     -------------------------
@@ -694,22 +675,6 @@ instance HFErrorProject InstallSetError where
   eDesc _ = "Installation or setting the tool failed."
 
 
--- | A test failed.
-data TestFailed = forall es . (ToVariantMaybe TestFailed es, PopVariant TestFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => TestFailed FilePath (V es)
-
-instance Pretty TestFailed where
-  pPrint (TestFailed path reason) =
-    case reason of
-      VMaybe (_ :: TestFailed) -> pPrint reason
-      _ -> text ("The test failed. GHC test suite is fragile and non-portable. Please also check out the " <> linkEscapeCode "issue tracker" " https://gitlab.haskell.org/ghc/ghc/-/issues/?sort=updated_desc&state=opened&label_name%5B%5D=testsuite&label_name%5B%5D=packaging&first_page_size=20" <> ".\nBuild dir was:") <+> text path <+> text "\nReason was:" <+> pPrint reason
-
-deriving instance Show TestFailed
-
-instance HFErrorProject TestFailed where
-  eBase _ = 4000
-  eNum (TestFailed _ xs2) = 4000 + eNum xs2
-  eDesc _ = "The test failed."
-
 -- | A build failed.
 data BuildFailed = forall es . (ToVariantMaybe BuildFailed es, PopVariant BuildFailed es, Pretty (V es), Show (V es), HFErrorProject (V es)) => BuildFailed FilePath (V es)
 

lib/GHCup/GHC.hs

@@ -86,144 +86,6 @@ data GHCVer v = SourceDist v
 
 
 
-    --------------------
-    --[ Tool testing ]--
-    --------------------
-
-
-
-testGHCVer :: ( MonadFail m
-              , MonadMask m
-              , MonadCatch m
-              , MonadReader env m
-              , HasDirs env
-              , HasSettings env
-              , HasPlatformReq env
-              , HasGHCupInfo env
-              , HasLog env
-              , MonadResource m
-              , MonadIO m
-              , MonadUnliftIO m
-              )
-           => Version
-           -> [T.Text]
-           -> Excepts
-                '[ DigestError
-                 , ContentLengthError
-                 , GPGError
-                 , DownloadFailed
-                 , NoDownload
-                 , ArchiveResult
-                 , TarDirDoesNotExist
-                 , UnknownArchive
-                 , TestFailed
-                 ]
-                m
-                ()
-testGHCVer ver addMakeArgs = do
-  GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
-
-  dlInfo <-
-    preview (ix GHC % ix ver % viTestDL % _Just) dls
-      ?? NoDownload
-
-  liftE $ testGHCBindist dlInfo ver addMakeArgs
-
-
-
-testGHCBindist :: ( MonadFail m
-                  , MonadMask m
-                  , MonadCatch m
-                  , MonadReader env m
-                  , HasDirs env
-                  , HasSettings env
-                  , HasPlatformReq env
-                  , HasGHCupInfo env
-                  , HasLog env
-                  , MonadResource m
-                  , MonadIO m
-                  , MonadUnliftIO m
-                  )
-               => DownloadInfo
-               -> Version
-               -> [T.Text]
-               -> Excepts
-                    '[ DigestError
-                     , ContentLengthError
-                     , GPGError
-                     , DownloadFailed
-                     , NoDownload
-                     , ArchiveResult
-                     , TarDirDoesNotExist
-                     , UnknownArchive
-                     , TestFailed
-                     ]
-                    m
-                    ()
-testGHCBindist dlinfo ver addMakeArgs = do
-  -- download (or use cached version)
-  dl <- liftE $ downloadCached dlinfo Nothing
-
-  liftE $ testPackedGHC dl (view dlSubdir dlinfo) ver addMakeArgs
-
-
-testPackedGHC :: ( MonadMask m
-                 , MonadCatch m
-                 , MonadReader env m
-                 , HasDirs env
-                 , HasPlatformReq env
-                 , HasSettings env
-                 , MonadThrow m
-                 , HasLog env
-                 , MonadIO m
-                 , MonadUnliftIO m
-                 , MonadFail m
-                 , MonadResource m
-                 )
-              => FilePath          -- ^ Path to the packed GHC bindist
-              -> Maybe TarDir      -- ^ Subdir of the archive
-              -> Version           -- ^ The GHC version
-              -> [T.Text]          -- ^ additional make args
-              -> Excepts
-                   '[ ArchiveResult, UnknownArchive, TarDirDoesNotExist, TestFailed ] m ()
-testPackedGHC dl msubdir ver addMakeArgs = do
-  -- unpack
-  tmpUnpack <- lift mkGhcupTmpDir
-  liftE $ cleanUpOnError tmpUnpack (unpackToDir (fromGHCupPath tmpUnpack) dl)
-
-  -- the subdir of the archive where we do the work
-  workdir <- maybe (pure tmpUnpack)
-                   (liftE . intoSubdir tmpUnpack)
-                   msubdir
-
-  reThrowAll @_ @'[ArchiveResult, UnknownArchive, TarDirDoesNotExist, ProcessError]
-    (TestFailed (fromGHCupPath workdir)) $ liftE $ runBuildAction tmpUnpack
-                         (testUnpackedGHC workdir ver addMakeArgs)
-
-testUnpackedGHC :: ( MonadReader env m
-                   , HasDirs env
-                   , HasSettings env
-                   , MonadThrow m
-                   , HasLog env
-                   , MonadIO m
-                   )
-                => GHCupPath         -- ^ Path to the unpacked GHC bindist (where the make file resides)
-                -> Version           -- ^ The GHC version
-                -> [T.Text]          -- ^ additional configure args for bindist
-                -> Excepts '[ProcessError] m ()
-testUnpackedGHC path ver addMakeArgs = do
-  lift $ logInfo $ "Testing GHC version " <> prettyVer ver <> "!"
-  ghcDir <- lift $ ghcupGHCDir (mkTVer ver)
-  let ghcBinDir = fromGHCupPath ghcDir </> "bin"
-  env <- liftIO $ addToPath ghcBinDir False
-
-  lEM $ make' (fmap T.unpack addMakeArgs)
-              (Just $ fromGHCupPath path)
-              "ghc-test"
-              (Just $ ("STAGE1_GHC", "ghc-" <> T.unpack (prettyVer ver)) : env)
-  pure ()
-
-
     ---------------------
     --[ Tool fetching ]--
     ---------------------

lib/GHCup/Prelude/Ansi.hs

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

lib/GHCup/Prelude/File/Posix.hs

@@ -279,11 +279,11 @@ removeEmptyDirectory = PD.removeDirectory
 
 -- | Create an 'Unfold' of directory contents.
 unfoldDirContents :: (MonadMask m, MonadIO m, S.MonadAsync m) => Unfold m FilePath (FD.DirType, FilePath)
-unfoldDirContents = U.bracket (liftIO . openDirStreamPortable) (liftIO . closeDirStreamPortable) (Unfold step return)
+unfoldDirContents = U.bracket (liftIO . openDirStream) (liftIO . closeDirStream) (Unfold step return)
  where
   {-# INLINE [0] step #-}
   step dirstream = do
-    (typ, e) <- liftIO $ readDirEntPortable dirstream
+    (typ, e) <- liftIO $ readDirEnt dirstream
     return $ if
       | null e    -> D.Stop
       | "." == e  -> D.Skip dirstream
@@ -308,8 +308,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
   step (_, Nothing, []) = return D.Stop
 
   step (topdir, Just (cdir, dirstream, finalizer), dirs) = flip onException (runIOFinalizer finalizer) $ do
-    (dt, f) <- liftIO $ readDirEntPortable dirstream
-    if | f == "" -> do
+    (dt, f) <- liftIO $ readDirEnt dirstream
+    if | FD.dtUnknown == dt -> do
            runIOFinalizer finalizer
            return $ D.Skip (topdir, Nothing, dirs)
        | f == "." || f == ".."
@@ -323,8 +323,8 @@ getDirectoryContentsRecursiveUnfold = Unfold step (\s -> return (s, Nothing, [""
 
   acquire dir =
     withRunInIO $ \run -> mask_ $ run $ do
-        dirstream <- liftIO $ openDirStreamPortable dir
-        ref <- newIOFinalizer (liftIO $ closeDirStreamPortable dirstream)
+        dirstream <- liftIO $ openDirStream dir
+        ref <- newIOFinalizer (liftIO $ closeDirStream dirstream)
         return (dirstream, ref)
 
 getDirectoryContentsRecursiveBFSUnsafe :: (MonadMask m, MonadIO m, S.MonadAsync m)

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

@@ -10,20 +10,9 @@
 module GHCup.Prelude.File.Posix.Traversals (
 -- lower-level stuff
   readDirEnt
-, readDirEntPortable
-, openDirStreamPortable
-, closeDirStreamPortable
 , unpackDirStream
-, DirStreamPortable
 ) where
 
-#include <limits.h>
-#include <stdlib.h>
-#include <dirent.h>
-#include <sys/types.h>
-#include <sys/stat.h>
-#include <fcntl.h>
-
 
 #if __GLASGOW_HASKELL__ < 710
 import Control.Applicative ((<$>))
@@ -39,7 +28,6 @@ import Foreign.Storable
 import System.Posix
 import Foreign (alloca)
 import System.Posix.Internals (peekFilePath)
-import System.FilePath
 
 
 
@@ -102,38 +90,3 @@ readDirEnt (unpackDirStream -> dirp) =
                     then return (dtUnknown, mempty)
                     else throwErrno "readDirEnt"
 
-
-newtype DirStreamPortable = DirStreamPortable (FilePath, DirStream)
-
-openDirStreamPortable :: FilePath -> IO DirStreamPortable
-openDirStreamPortable fp = do
-  dirs <- openDirStream fp
-  pure $ DirStreamPortable (fp, dirs)
-
-closeDirStreamPortable :: DirStreamPortable -> IO ()
-closeDirStreamPortable (DirStreamPortable (_, dirs)) = closeDirStream dirs
-
-readDirEntPortable :: DirStreamPortable -> IO (DirType, FilePath)
-readDirEntPortable (DirStreamPortable (basedir, dirs)) = do
-  (dt, fp) <- readDirEnt dirs
-  case (dt, fp) of
-    (DirType #{const DT_BLK}, _)     -> pure (dt, fp)
-    (DirType #{const DT_CHR}, _)     -> pure (dt, fp)
-    (DirType #{const DT_DIR}, _)     -> pure (dt, fp)
-    (DirType #{const DT_FIFO}, _)    -> pure (dt, fp)
-    (DirType #{const DT_LNK}, _)     -> pure (dt, fp)
-    (DirType #{const DT_REG}, _)     -> pure (dt, fp)
-    (DirType #{const DT_SOCK}, _)    -> pure (dt, fp)
-    (DirType #{const DT_UNKNOWN}, _) -> pure (dt, fp)
-    (_, _)
-      | fp /= "" -> do
-          stat <- getSymbolicLinkStatus (basedir </> fp)
-          pure $ (, fp) $ if | isBlockDevice stat     -> DirType #{const DT_BLK}
-                             | isCharacterDevice stat -> DirType #{const DT_CHR}
-                             | isDirectory stat       -> DirType #{const DT_DIR}
-                             | isNamedPipe stat       -> DirType #{const DT_FIFO}
-                             | isSymbolicLink stat    -> DirType #{const DT_LNK}
-                             | isRegularFile stat     -> DirType #{const DT_REG}
-                             | isSocket stat          -> DirType #{const DT_SOCK}
-                             | otherwise              -> DirType #{const DT_UNKNOWN}
-

lib/GHCup/Types.hs

@@ -66,7 +66,7 @@ data GHCupInfo = GHCupInfo
   , _ghcupDownloads   :: GHCupDownloads
   , _globalTools      :: Map GlobalTool DownloadInfo
   }
-  deriving (Show, GHC.Generic, Eq)
+  deriving (Show, GHC.Generic)
 
 instance NFData GHCupInfo
 
@@ -87,7 +87,7 @@ data Requirements = Requirements
   { _distroPKGs :: [Text]
   , _notes      :: Text
   }
-  deriving (Show, GHC.Generic, Eq)
+  deriving (Show, GHC.Generic)
 
 instance NFData Requirements
 
@@ -138,7 +138,6 @@ data VersionInfo = VersionInfo
   { _viTags        :: [Tag]              -- ^ version specific tag
   , _viChangeLog   :: Maybe URI
   , _viSourceDL    :: Maybe DownloadInfo -- ^ source tarball
-  , _viTestDL      :: Maybe DownloadInfo -- ^ test tarball
   , _viArch        :: ArchitectureSpec   -- ^ descend for binary downloads per arch
   -- informative messages
   , _viPostInstall :: Maybe Text
@@ -275,23 +274,6 @@ instance NFData DownloadInfo
     --[ Others ]--
     --------------
 
-data DownloadMirror = DownloadMirror {
-     authority :: Authority
-   , pathPrefix :: Maybe Text
-} deriving (Eq, Ord, GHC.Generic, Show)
-
-instance NFData DownloadMirror
-
-newtype DownloadMirrors = DM (Map Text DownloadMirror)
-  deriving (Eq, Ord, GHC.Generic, Show)
-
-instance NFData DownloadMirrors
-
-instance NFData UserInfo
-instance NFData Host
-instance NFData Port
-instance NFData Authority
-
 
 -- | How to descend into a tar archive.
 data TarDir = RealDir FilePath
@@ -334,13 +316,12 @@ data UserSettings = UserSettings
   , uUrlSource   :: Maybe URLSource
   , uNoNetwork   :: Maybe Bool
   , uGPGSetting  :: Maybe GPGSetting
-  , uPlatformOverride :: Maybe PlatformRequest
-  , uMirrors     :: Maybe DownloadMirrors
+  , uPlatformOverride    :: Maybe PlatformRequest
   }
   deriving (Show, GHC.Generic)
 
 defaultUserSettings :: UserSettings
-defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+defaultUserSettings = UserSettings Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
 
 fromSettings :: Settings -> Maybe KeyBindings -> UserSettings
 fromSettings Settings{..} Nothing =
@@ -357,7 +338,6 @@ fromSettings Settings{..} Nothing =
     , uUrlSource = Just urlSource
     , uGPGSetting = Just gpgSetting
     , uPlatformOverride = platformOverride
-    , uMirrors = Just mirrors
   }
 fromSettings Settings{..} (Just KeyBindings{..}) =
   let ukb = UserKeyBindings
@@ -384,7 +364,6 @@ fromSettings Settings{..} (Just KeyBindings{..}) =
     , uUrlSource = Just urlSource
     , uGPGSetting = Just gpgSetting
     , uPlatformOverride = platformOverride
-    , uMirrors = Just mirrors
   }
 
 data UserKeyBindings = UserKeyBindings
@@ -414,9 +393,7 @@ data KeyBindings = KeyBindings
   deriving (Show, GHC.Generic)
 
 instance NFData KeyBindings
-#if defined(IS_WINDOWS) || !defined(BRICK)
 instance NFData Key
-#endif
 
 defaultKeyBindings :: KeyBindings
 defaultKeyBindings = KeyBindings
@@ -468,7 +445,6 @@ data Settings = Settings
   , gpgSetting       :: GPGSetting
   , noColor          :: Bool -- this also exists in LoggerConfig
   , platformOverride :: Maybe PlatformRequest
-  , mirrors          :: DownloadMirrors
   }
   deriving (Show, GHC.Generic)
 
@@ -476,7 +452,7 @@ defaultMetaCache :: Integer
 defaultMetaCache = 300 -- 5 minutes
 
 defaultSettings :: Settings
-defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing (DM mempty)
+defaultSettings = Settings False defaultMetaCache Lax False Never Curl False GHCupURL False GPGNone False Nothing
 
 instance NFData Settings
 

lib/GHCup/Types/JSON.hs

@@ -29,7 +29,6 @@ import           Control.Applicative            ( (<|>) )
 import           Data.Aeson              hiding (Key)
 import           Data.Aeson.TH
 import           Data.Aeson.Types        hiding (Key)
-import           Data.ByteString                ( ByteString )
 import           Data.List.NonEmpty             ( NonEmpty(..) )
 import           Data.Text.Encoding            as E
 import           Data.Versions
@@ -226,12 +225,6 @@ instance FromJSON VersionCmp where
       Right r -> pure r
       Left  e -> fail (MP.errorBundlePretty e)
 
-instance ToJSON ByteString where
-  toJSON = toJSON . E.decodeUtf8With E.lenientDecode
-
-instance FromJSON ByteString where
-  parseJSON = withText "ByteString" $ \t -> pure $ E.encodeUtf8 t
-
 versionCmpToText :: VersionCmp -> T.Text
 versionCmpToText (VR_gt   ver') = "> " <> prettyV ver'
 versionCmpToText (VR_gteq ver') = ">= " <> prettyV ver'
@@ -327,12 +320,6 @@ deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''GHCupI
 deriveToJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''URLSource
 deriveJSON defaultOptions { sumEncoding = ObjectWithSingleField } ''Key
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "k-") . T.pack . kebab $ str' } ''UserKeyBindings
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Port
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel, unwrapUnaryRecords = True } ''Host
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''UserInfo
-deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' (T.unpack . T.toLower) . T.stripPrefix (T.pack "authority") . T.pack $ str' } ''Authority
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirror
-deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''DownloadMirrors
 deriveToJSON defaultOptions { fieldLabelModifier = kebab } ''Settings
 deriveToJSON defaultOptions { fieldLabelModifier = drop 2 . kebab } ''KeyBindings -- move under key-bindings key
 
@@ -369,3 +356,4 @@ instance FromJSON URLSource where
       pure (AddSource r)
 
 deriveJSON defaultOptions { fieldLabelModifier = \str' -> maybe str' T.unpack . T.stripPrefix (T.pack "u-") . T.pack . kebab $ str' } ''UserSettings
+

lib/GHCup/Utils.hs

@@ -93,7 +93,6 @@ import qualified Data.List.NonEmpty            as NE
 import qualified Streamly.Prelude              as S
 import Control.DeepSeq (force)
 import GHC.IO (evaluate)
-import System.Environment (getEnvironment, setEnv)
 
 
 -- $setup
@@ -968,28 +967,11 @@ make :: ( MonadThrow m
      => [String]
      -> Maybe FilePath
      -> m (Either ProcessError ())
-make args workdir = make' args workdir "ghc-make" Nothing
-
-
--- | Calls gmake if it exists in PATH, otherwise make.
-make' :: ( MonadThrow m
-         , MonadIO m
-         , MonadReader env m
-         , HasDirs env
-         , HasLog env
-         , HasSettings env
-         )
-      => [String]
-      -> Maybe FilePath
-      -> FilePath         -- ^ log filename (opened in append mode)
-      -> Maybe [(String, String)] -- ^ optional environment
-      -> m (Either ProcessError ())
-make' args workdir logfile menv = do
+make args workdir = do
   spaths    <- liftIO getSearchPath
   has_gmake <- isJust <$> liftIO (searchPath spaths "gmake")
   let mymake = if has_gmake then "gmake" else "make"
-  execLogged mymake args workdir logfile menv
-
+  execLogged mymake args workdir "ghc-make" Nothing
 
 makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
         => [String]
@@ -1300,22 +1282,6 @@ warnAboutHlsCompatibility = do
 
 
 
-addToPath :: FilePath
-          -> Bool         -- ^ if False will prepend
-          -> IO [(String, String)]
-addToPath path append = do
- cEnv <- Map.fromList <$> getEnvironment
- let paths          = ["PATH", "Path"]
-     curPaths       = (\x -> maybe [] splitSearchPath (Map.lookup x cEnv)) =<< paths
-     {- HLINT ignore "Redundant bracket" -}
-     newPath        = intercalate [searchPathSeparator] (if append then (curPaths ++ [path]) else (path : curPaths))
-     envWithoutPath = foldr (\x y -> Map.delete x y) cEnv paths
-     pathVar        = if isWindows then "Path" else "PATH"
-     envWithNewPath = Map.toList $ Map.insert pathVar newPath envWithoutPath
- liftIO $ setEnv pathVar newPath
- return envWithNewPath
-
-
     -----------
     --[ Git ]--
     -----------

mkdocs.yml

@@ -2,6 +2,7 @@ site_name: GHCup
 site_url: https://www.haskell.org/ghcup
 site_description: GHCup is the main installer for the general purpose language Haskell.
 site_author: GHCup Team
+site_favicon: haskell_logo.png
 
 repo_url: https://github.com/haskell/ghcup-hs
 

scripts/bootstrap/bootstrap-haskell

@@ -28,7 +28,7 @@
 
 plat="$(uname -s)"
 arch=$(uname -m)
-ghver="0.1.19.1"
+ghver="0.1.18.0"
 : "${GHCUP_BASE_URL:=https://downloads.haskell.org/~ghcup}"
 
 export GHCUP_SKIP_UPDATE_CHECK=yes
@@ -119,26 +119,20 @@ edo() {
     "$@" || die "\"$*\" failed!"
 }
 
-eghcup_raw() {
-	"${GHCUP_BIN}/ghcup" "$@" || die "\"ghcup $*\" failed!"
-}
-
 eghcup() {
-	_eghcup "$@"
+	edo _eghcup "$@"
 }
 
 _eghcup() {
 	if [ -n "${BOOTSTRAP_HASKELL_YAML}" ] ; then
-		args="-s ${BOOTSTRAP_HASKELL_YAML} --metadata-fetching-mode=Strict"
-    else
-		args="--metadata-fetching-mode=Strict"
+		args="-s ${BOOTSTRAP_HASKELL_YAML}"
 	fi
     if [ -z "${BOOTSTRAP_HASKELL_VERBOSE}" ] ; then
         # shellcheck disable=SC2086
-        "${GHCUP_BIN}/ghcup" ${args} "$@" || die "\"ghcup ${args} $*\" failed!"
+        "${GHCUP_BIN}/ghcup" ${args} "$@"
     else
         # shellcheck disable=SC2086
-        "${GHCUP_BIN}/ghcup" ${args} --verbose "$@" || die "\"ghcup ${args} --verbose $*\" failed!"
+        "${GHCUP_BIN}/ghcup" ${args} --verbose "$@"
     fi
 }
 
@@ -153,7 +147,7 @@ _ecabal() {
 }
 
 ecabal() {
-	_ecabal "$@" || die "\"cabal $*\" failed!"
+	edo _ecabal "$@"
 }
 
 _done() {
@@ -288,6 +282,14 @@ download_ghcup() {
 			esac
 			;;
         "FreeBSD"|"freebsd")
+            if freebsd-version | grep -E '^12.*' ; then
+                freebsd_ver=12
+            elif freebsd-version | grep -E '^13.*' ; then
+                freebsd_ver=13
+            else
+                die "Unsupported FreeBSD version! Please report a bug at https://github.com/haskell/ghcup-hs/issues"
+            fi
+
 			case "${arch}" in
 				x86_64|amd64)
 					;;
@@ -297,7 +299,7 @@ download_ghcup() {
 				*) die "Unknown architecture: ${arch}"
 					;;
 			esac
-			_url=${GHCUP_BASE_URL}/${ghver}/x86_64-portbld-freebsd-ghcup-${ghver}
+			_url=${GHCUP_BASE_URL}/${ghver}/x86_64-freebsd${freebsd_ver}-ghcup-${ghver}
             ;;
         "Darwin"|"darwin")
 			case "${arch}" in
@@ -385,10 +387,10 @@ download_ghcup() {
     edo . "${GHCUP_DIR}"/env
     case "${BOOTSTRAP_HASKELL_DOWNLOADER}" in
         "curl")
-            eghcup_raw config set downloader Curl
+            eghcup config set downloader Curl
             ;;
         "wget")
-            eghcup_raw config set downloader Wget
+            eghcup config set downloader Wget
             ;;
         *)
             die "Unknown downloader: ${BOOTSTRAP_HASKELL_DOWNLOADER}"
@@ -793,7 +795,7 @@ edo mkdir -p "${GHCUP_BIN}"
 
 if command -V "ghcup" >/dev/null 2>&1 ; then
     if [ -z "${BOOTSTRAP_HASKELL_NO_UPGRADE}" ] ; then
-        ( _eghcup upgrade ) || download_ghcup
+        _eghcup upgrade || download_ghcup
     fi
 else
 	download_ghcup
@@ -840,17 +842,17 @@ fi
 
 case $ask_hls_answer in
 	1)
-        (_eghcup --cache install hls) || warn "HLS installation failed, continuing anyway"
+		_eghcup --cache install hls || warn "HLS installation failed, continuing anyway"
 		;;
 	*) ;;
 esac
 
 case $ask_stack_answer in
 	1)
-        (_eghcup --cache install stack) || die "Stack installation failed"
+		_eghcup --cache install stack || die "Stack installation failed"
 		;;
 	2)
-        (_eghcup --cache install stack) || die "Stack installation failed"
+		_eghcup --cache install stack || die "Stack installation failed"
         edo mkdir -p "${STACK_ROOOT:-$HOME/.stack}"/hooks
         hook_exe="${STACK_ROOOT:-$HOME/.stack}"/hooks/ghc-install.sh
         hook_url="https://www.haskell.org/ghcup/sh/hooks/stack/ghc-install.sh"

scripts/bootstrap/bootstrap-haskell.ps1

@@ -432,13 +432,12 @@ if (!(Test-Path -Path ('{0}' -f $MsysDir))) {
 	}
     Print-Msg -msg ('Downloading Msys2 archive {0}...' -f $Msys2Version)
     $archive = ('msys2-base-x86_64-{0}.sfx.exe' -f $Msys2Version)
-    $msysUrl = ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
     $archivePath = ('{0}\{1}' -f ([IO.Path]::GetTempPath()), "$archive")
 
     if ((Get-Command -Name 'curl.exe' -ErrorAction SilentlyContinue) -and !($DisableCurl)) {
-      Exec "curl.exe" '-o' "$archivePath" "$msysUrl"
+      Exec "curl.exe" '-o' "$archivePath" ('https://repo.msys2.org/distrib/x86_64/{0}' -f "$archive")
     } else {
-      Get-FileWCSynchronous -url "$msysUrl" -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
+      Get-FileWCSynchronous -url ('https://repo.msys2.org/distrib/{0}' -f $archive) -destinationFolder ([IO.Path]::GetTempPath()) -includeStats
     }
 
     Print-Msg -msg 'Extracting Msys2 archive...'

scripts/releasing/pull_release_artifacts.sh

@@ -1,36 +1,49 @@
-#!/bin/bash
 
 set -eu
-set -o pipefail
 
-shopt -s extglob
+tag=v$1
+ver=$1
 
-RELEASE=$1
-SIGNER=$2
+dest=$2
+gpg_user=$3
 
-echo "RELEASE: $RELEASE"
-echo "SIGNER: $SIGNER"
+mkdir -p "${dest}"
 
-for com in gh gpg curl sha256sum ; do
-	command -V ${com} >/dev/null 2>&1
-done
+cd "${dest}"
 
-[ ! -e "gh-release-artifacts/${RELEASE}" ]
+base_url="https://gitlab.haskell.org/api/v4/projects/618/jobs/artifacts/${tag}/raw"
 
-mkdir -p "gh-release-artifacts/${RELEASE}"
+curl -f -o "x86_64-apple-darwin-ghcup-${ver}" \
+	"${base_url}/out/x86_64-apple-darwin-ghcup-${ver}?job=release:darwin"
 
-git archive --format=tar.gz -o "gh-release-artifacts/${RELEASE}/ghcup-${RELEASE}-src.tar.gz" --prefix="ghcup-${RELEASE}/" HEAD
+curl -f -o "aarch64-apple-darwin-ghcup-${ver}" \
+	"${base_url}/out/aarch64-apple-darwin-ghcup-${ver}?job=release:darwin:aarch64"
 
-cd "gh-release-artifacts/${RELEASE}"
+curl -f -o "x86_64-freebsd12-ghcup-${ver}" \
+	"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd12"
 
-# github
-gh release download "$RELEASE"
+curl -f -o "x86_64-freebsd13-ghcup-${ver}" \
+	"${base_url}/out/x86_64-portbld-freebsd-ghcup-${ver}?job=release:freebsd13"
+
+curl -f -o "i386-linux-ghcup-${ver}" \
+	"${base_url}/out/i386-linux-ghcup-${ver}?job=release:linux:32bit"
+
+curl -f -o "x86_64-linux-ghcup-${ver}" \
+	"${base_url}/out/x86_64-linux-ghcup-${ver}?job=release:linux:64bit"
+
+curl -f -o "aarch64-linux-ghcup-${ver}" \
+	"${base_url}/out/aarch64-linux-ghcup-${ver}?job=release:linux:aarch64"
+
+curl -f -o "armv7-linux-ghcup-${ver}" \
+	"${base_url}/out/armv7-linux-ghcup-${ver}?job=release:linux:armv7"
+
+curl -f -o "x86_64-mingw64-ghcup-${ver}.exe" \
+	"${base_url}/out/x86_64-mingw64-ghcup-${ver}.exe?job=release:windows"
+
+rm -f *.sig
+sha256sum *-ghcup-* > SHA256SUMS
+gpg --detach-sign -u ${gpg_user} SHA256SUMS
+for f in *-ghcup-* ; do gpg --detach-sign -u ${gpg_user} $f ; done
 
-# cirrus
-curl -L -o "x86_64-portbld-freebsd-ghcup-${RELEASE}" \
-	"https://api.cirrus-ci.com/v1/artifact/github/haskell/ghcup-hs/build/binaries/out/x86_64-portbld-freebsd-ghcup-${RELEASE}?branch=${RELEASE}"
 
-sha256sum ./*-ghcup-* > SHA256SUMS
-gpg --detach-sign -u "${SIGNER}" SHA256SUMS
 
-gh release upload "$RELEASE" "ghcup-${RELEASE}-src.tar.gz" "x86_64-portbld-freebsd-ghcup-${RELEASE}" SHA256SUMS SHA256SUMS.sig

scripts/releasing/sftp-symlink-artifacts.sh

@@ -21,14 +21,16 @@ rm i386-linux-ghcup
 rm x86_64-apple-darwin-ghcup
 rm x86_64-linux-ghcup
 rm x86_64-mingw64-ghcup.exe
-rm x86_64-portbld-freebsd-ghcup
+rm x86_64-freebsd12-ghcup
+rm x86_64-freebsd13-ghcup
 
 symlink ${ver}/aarch64-apple-darwin-ghcup-${ver} aarch64-apple-darwin-ghcup
 symlink ${ver}/aarch64-linux-ghcup-${ver} aarch64-linux-ghcup
 symlink ${ver}/armv7-linux-ghcup-${ver} armv7-linux-ghcup
 symlink ${ver}/i386-linux-ghcup-${ver} i386-linux-ghcup
 symlink ${ver}/x86_64-apple-darwin-ghcup-${ver} x86_64-apple-darwin-ghcup
-symlink ${ver}/x86_64-portbld-freebsd-ghcup-${ver} x86_64-portbld-freebsd-ghcup
+symlink ${ver}/x86_64-freebsd12-ghcup-${ver} x86_64-freebsd12-ghcup
+symlink ${ver}/x86_64-freebsd13-ghcup-${ver} x86_64-freebsd13-ghcup
 symlink ${ver}/x86_64-linux-ghcup-${ver} x86_64-linux-ghcup
 symlink ${ver}/x86_64-mingw64-ghcup-${ver}.exe x86_64-mingw64-ghcup.exe
 EOF

scripts/releasing/sftp-upload-artifacts.sh

@@ -25,28 +25,22 @@ put SHA256SUMS
 put SHA256SUMS.sig
 put aarch64-apple-darwin-ghcup-${ver}
 put aarch64-apple-darwin-ghcup-${ver}.sig
-put aarch64-apple-darwin-ghcup.plan.json
 put aarch64-linux-ghcup-${ver}
 put aarch64-linux-ghcup-${ver}.sig
-put aarch64-linux-ghcup.plan.json
 put armv7-linux-ghcup-${ver}
 put armv7-linux-ghcup-${ver}.sig
-put armv7-linux-ghcup.plan.json
 put i386-linux-ghcup-${ver}
 put i386-linux-ghcup-${ver}.sig
-put i386-linux-ghcup.plan.json
 put x86_64-apple-darwin-ghcup-${ver}
 put x86_64-apple-darwin-ghcup-${ver}.sig
-put x86_64-apple-darwin-ghcup.plan.json
-put x86_64-portbld-freebsd-ghcup-${ver}
-put x86_64-portbld-freebsd-ghcup-${ver}.sig
-put x86_64-portbld-freebsd-ghcup.plan.json
+put x86_64-freebsd12-ghcup-${ver}
+put x86_64-freebsd12-ghcup-${ver}.sig
+put x86_64-freebsd13-ghcup-${ver}
+put x86_64-freebsd13-ghcup-${ver}.sig
 put x86_64-linux-ghcup-${ver}
 put x86_64-linux-ghcup-${ver}.sig
-put x86_64-linux-ghcup.plan.json
 put x86_64-mingw64-ghcup-${ver}.exe
 put x86_64-mingw64-ghcup-${ver}.exe.sig
-put x86_64-mingw64-ghcup.plan.json
 EOF
 
 curl -X PURGE https://downloads.haskell.org/~ghcup/${ver}/

stack.yaml

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

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

@@ -24,11 +24,11 @@ spec = do
   -- https://github.com/haskell/ghcup-hs/issues/415
   describe "GHCup.Prelude.File.Posix.Traversals" $ do
     it "readDirEnt" $ do
-      dirstream <- liftIO $ openDirStreamPortable "test/data"
-      (dt1, fp1) <- readDirEntPortable dirstream
-      (dt2, fp2) <- readDirEntPortable dirstream
-      (dt3, fp3) <- readDirEntPortable dirstream
-      (dt4, fp4) <- readDirEntPortable dirstream
+      dirstream <- liftIO $ openDirStream "test/data"
+      (dt1, fp1) <- readDirEnt dirstream
+      (dt2, fp2) <- readDirEnt dirstream
+      (dt3, fp3) <- readDirEnt dirstream
+      (dt4, fp4) <- readDirEnt dirstream
       let xs = sortOn snd [ (dt1, fp1), (dt2, fp2)
                           , (dt3, fp3), (dt4, fp4)
                           ]

test/golden/unix/GHCupInfo.json

@@ -285,8 +285,7 @@
                             "base-8.7.6",
                             "Latest",
                             "Prerelease"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "7.5.5": {
                         "viArch": {
@@ -388,8 +387,7 @@
                             "base-4.7.6",
                             "\u0001+n𫛚\r",
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "7.7.6": {
                         "viArch": {
@@ -511,8 +509,7 @@
                             "old",
                             "base-3.1.4",
                             "Prerelease"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "8.8.6": {
                         "viArch": {
@@ -827,8 +824,7 @@
                             "base-5.2.3",
                             "Prerelease",
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 },
                 "HLS": {
@@ -1088,8 +1084,7 @@
                             "Latest",
                             "Latest",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "2.1.4": {
                         "viArch": {
@@ -1245,8 +1240,7 @@
                         "viTags": [
                             "Prerelease",
                             "base-4.7.4"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "3.3.7": {
                         "viArch": {
@@ -1676,8 +1670,7 @@
                             },
                             "dlUri": "https:mkzzunx"
                         },
-                        "viTags": [],
-                        "viTestDL": null
+                        "viTags": []
                     },
                     "3.5.3": {
                         "viArch": {
@@ -1979,8 +1972,7 @@
                             "old",
                             "Recommended",
                             "old"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "5.2.3": {
                         "viArch": {
@@ -2317,8 +2309,7 @@
                             "Latest",
                             "Recommended",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "8.5.2": {
                         "viArch": {
@@ -2440,8 +2431,7 @@
                             "Latest",
                             "Latest",
                             "base-8.7.3"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 }
             },
@@ -2890,8 +2880,7 @@
                             },
                             "dlUri": "https:zxekodom"
                         },
-                        "viTags": [],
-                        "viTestDL": null
+                        "viTags": []
                     },
                     "3.2.1": {
                         "viArch": {
@@ -3111,8 +3100,7 @@
                             "base-7.7.6",
                             "𩺈𥲬􅚷\u0015A~",
                             "old"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "4.5.3": {
                         "viArch": {
@@ -3342,8 +3330,7 @@
                             "base-1.5.2",
                             "Latest",
                             "old"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "7.3.9": {
                         "viArch": {
@@ -3701,8 +3688,7 @@
                             "base-1.6.1",
                             "Prerelease",
                             "old"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 },
                 "GHCup": {
@@ -3761,8 +3747,7 @@
                             "Latest",
                             "\u0005s톕$󵰇\"g",
                             "Prerelease"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "3.5.3": {
                         "viArch": {
@@ -3895,8 +3880,7 @@
                             "Latest",
                             "xZ\u000b",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "3.8.5": {
                         "viArch": {
@@ -4009,8 +3993,7 @@
                         "viSourceDL": null,
                         "viTags": [
                             "old"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "4.1.6": {
                         "viArch": {
@@ -4196,8 +4179,7 @@
                         "viTags": [
                             "Latest",
                             "old"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "7.5.4": {
                         "viArch": {
@@ -4474,8 +4456,7 @@
                         "viSourceDL": null,
                         "viTags": [
                             "鲤"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 },
                 "HLS": {
@@ -4846,8 +4827,7 @@
                             "",
                             "Ctj",
                             "􃰍|W󶶟d`"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "3.5.1": {
                         "viArch": {
@@ -4957,8 +4937,7 @@
                             "old",
                             "Latest",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "4.2.2": {
                         "viArch": {
@@ -5051,8 +5030,7 @@
                             "Recommended",
                             "Recommended",
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "4.4.1": {
                         "viArch": {
@@ -5144,8 +5122,7 @@
                             "Latest",
                             "Latest",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "5.7.2": {
                         "viArch": {
@@ -5496,8 +5473,7 @@
                             "Prerelease",
                             "Prerelease",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "7.1.4": {
                         "viArch": {
@@ -5583,8 +5559,7 @@
                             "Latest",
                             "\u0013ADq\u001bX<",
                             "base-8.2.4"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "8.2.3": {
                         "viArch": {
@@ -5692,8 +5667,7 @@
                             "𠖛",
                             "恦AD假n#",
                             "Prerelease"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "8.3.5": {
                         "viArch": {
@@ -6096,8 +6070,7 @@
                             "Prerelease",
                             "%󵠣R灡𑈃pS",
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 }
             },
@@ -7382,8 +7355,7 @@
                             "old",
                             "Latest",
                             "base-8.5.8"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "2.1.4": {
                         "viArch": {
@@ -8071,8 +8043,7 @@
                             "",
                             "\u0018\u0017GF󾐘\u0018",
                             "base-8.7.8"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "4.6.8": {
                         "viArch": {
@@ -8358,8 +8329,7 @@
                             "base-8.1.6",
                             "old",
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "5.1.8": {
                         "viArch": {
@@ -8559,8 +8529,7 @@
                             "Prerelease",
                             "~X6*𦥹",
                             "base-2.1.6"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "5.4.7": {
                         "viArch": {},
@@ -8580,8 +8549,7 @@
                             "󱪀9pR𥎷H",
                             "base-7.5.6",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 },
                 "Stack": {
@@ -8923,8 +8891,7 @@
                             },
                             "dlUri": "http:gji"
                         },
-                        "viTags": [],
-                        "viTestDL": null
+                        "viTags": []
                     },
                     "7.2.3": {
                         "viArch": {
@@ -9069,8 +9036,7 @@
                             "old",
                             "Recommended",
                             "base-2.5.2"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 }
             },
@@ -10447,8 +10413,7 @@
                             "Recommended",
                             "S鴖xz󾤞",
                             "Prerelease"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "4.4.4": {
                         "viArch": {
@@ -10760,8 +10725,7 @@
                             "Prerelease",
                             "old",
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "5.5.4": {
                         "viArch": {
@@ -11141,8 +11105,7 @@
                             "Latest",
                             "base-1.8.1",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "5.6.4": {
                         "viArch": {
@@ -11385,8 +11348,7 @@
                             "Prerelease",
                             ">/~l\u0019\u0001F\u0003",
                             "base-4.4.6"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "6.7.3": {
                         "viArch": {},
@@ -11405,8 +11367,7 @@
                         "viTags": [
                             "old",
                             "old"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "8.5.5": {
                         "viArch": {},
@@ -11427,8 +11388,7 @@
                             "Latest",
                             "base-3.6.3",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "8.6.5": {
                         "viArch": {
@@ -11810,8 +11770,7 @@
                             "v斾)k",
                             "Prerelease",
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 },
                 "GHC": {},
@@ -13582,8 +13541,7 @@
                         },
                         "viTags": [
                             "Prerelease"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "2.6.7": {
                         "viArch": {
@@ -13627,8 +13585,7 @@
                         "viSourceDL": null,
                         "viTags": [
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "3.3.5": {
                         "viArch": {
@@ -13651,8 +13608,7 @@
                             "&Z3𭹡X",
                             "Prerelease",
                             "Prerelease"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "3.4.4": {
                         "viArch": {
@@ -14109,8 +14065,7 @@
                             "f8\u0017xNft(",
                             "Recommended",
                             "Prerelease"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "6.5.7": {
                         "viArch": {
@@ -14287,8 +14242,7 @@
                             "dlSubdir": "􂮄qG+0󰊒t",
                             "dlUri": "http:vvn"
                         },
-                        "viTags": [],
-                        "viTestDL": null
+                        "viTags": []
                     },
                     "6.6.3": {
                         "viArch": {
@@ -14356,8 +14310,7 @@
                             "",
                             "\u0014𣉈C\u0018󼀇V",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "8.5.4": {
                         "viArch": {
@@ -14510,8 +14463,7 @@
                             "Latest",
                             "\u0005I{5\u0013",
                             "base-3.8.8"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 },
                 "GHCup": {
@@ -14683,8 +14635,7 @@
                             "Latest",
                             "old",
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "4.3.4": {
                         "viArch": {
@@ -14880,8 +14831,7 @@
                             "\u0017M􆼘󴞻",
                             "old",
                             "Recommended"
-                        ],
-                        "viTestDL": null
+                        ]
                     },
                     "8.6.2": {
                         "viArch": {
@@ -15217,8 +15167,7 @@
                             "Prerelease",
                             "Prerelease",
                             "base-5.1.6"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 },
                 "Stack": {
@@ -15575,8 +15524,7 @@
                         },
                         "viTags": [
                             "Latest"
-                        ],
-                        "viTestDL": null
+                        ]
                     }
                 }
             },

vendored/ansi-terminal-game-1.8.0.0/COPYING

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

vendored/ansi-terminal-game-1.8.0.0/NEWS

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

vendored/ansi-terminal-game-1.8.0.0/README

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@@ -0,0 +1,29 @@
+--------------------------------------------------------------------------------
+-- Nonbuffering getChar et al
+-- 2017 Francesco Ariis GPLv3                                             80cols
+--------------------------------------------------------------------------------
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+-- horrible horrible horrible hack to make unbuffered input
+-- work on Windows (and win32console check)
+
+module Terminal.Game.Utils (inputCharTerminal,
+                            isWin32Console )
+                           where
+
+import qualified Data.Char             as C
+import qualified Foreign.C.Types       as FT
+import qualified System.Console.MinTTY as M
+
+inputCharTerminal :: IO Char
+inputCharTerminal = getCharWindows
+
+-- no idea why, but unsafe breaks it
+getCharWindows :: IO Char
+getCharWindows = fmap (C.chr . fromEnum) c_getch
+foreign import ccall safe "conio.h getch"
+  c_getch :: IO FT.CInt
+
+-- not perfect, but it is what it is (on win, non minTTY)
+isWin32Console :: IO Bool
+isWin32Console = not <$> M.isMinTTY

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game.hs

@@ -0,0 +1,206 @@
+-------------------------------------------------------------------------------
+-- |
+-- Module      :  Terminal.Game
+-- Copyright   :  © 2017-2021 Francesco Ariis
+-- License     :  GPLv3 (see COPYING file)
+--
+-- Maintainer  :  Francesco Ariis <fa-ml@ariis.it>
+-- Stability   :  provisional
+-- Portability :  portable
+--
+-- Machinery and utilities for 2D terminal games.
+--
+-- New? Start from 'Game'.
+--
+-------------------------------------------------------------------------------
+
+-- Basic col-on-black ASCII terminal, operations.
+-- Only module to be imported.
+
+module Terminal.Game ( -- * Running
+                       TPS,
+                       FPS,
+                       Event(..),
+                       GEnv(..),
+                       Game,
+                       GameT(..),
+                       playGame,
+                       playGameT,
+                       ATGException(..),
+
+                       -- ** Helpers
+                       playGameS,
+                       Terminal.Game.displaySize,
+                       assertTermDims,
+                       errorPress,
+                       blankPlaneFull,
+                       centerFull,
+                       cleanAndExit,
+
+                       -- * Game logic
+                       -- | Some convenient function dealing with
+                       -- Timers ('Timed') and 'Animation's.
+                       --
+                       -- Usage of these is not mandatory: 'Game' is
+                       -- parametrised over any state @s@, you are free
+                       -- to implement game logic as you prefer.
+
+                       -- ** Timers/Animation
+
+                       -- *** Timers
+                       Timed,
+                       creaTimer, creaBoolTimer,
+                       creaTimerLoop, creaBoolTimerLoop,
+
+                       -- *** Animations
+                       Animation,
+                       creaAnimation,
+                       creaLoopAnimation,
+
+                       -- *** T/A interface
+                       tick, ticks, reset, lapse,
+                       fetchFrame, isExpired,
+
+                       -- ** Random numbers
+                       StdGen,
+                       getStdGen, mkStdGen,
+                       getRandom, pickRandom,
+                       UniformRange,
+
+                       -- * Drawing
+                       -- | To get to the gist of drawing, check the
+                       -- documentation for '%'.
+                       --
+                       -- Blitting on screen is double-buffered and diff'd
+                       -- (at each frame, only cells with changed character
+                       -- will be redrawn).
+
+                       -- ** Plane
+                       Plane,
+                       Dimensions,
+                       Coords,
+                       Row, Column,
+                       Width, Height,
+                       blankPlane,
+                       stringPlane,
+                       stringPlaneTrans,
+                       makeTransparent,
+                       makeOpaque,
+                       planePaper,
+                       planeSize,
+
+                       -- ** Draw
+                       Draw,
+                       (%), (&), (#),
+                       subPlane,
+                       mergePlanes,
+                       cell, word, box,
+                       Color(..), ColorIntensity(..),
+                       color, bold, invert,
+
+                       -- *** Alternative origins
+                       -- $origins
+                       (%^>), (%.<), (%.>),
+
+                       -- *** Text boxes
+                       textBox, textBoxLiquid,
+                       textBoxHyphen, textBoxHyphenLiquid,
+                       Hyphenator,
+                       -- | Eurocentric convenience reexports. Check
+                       -- "Text.Hyphenation.Language" for more languages.
+                       english_GB, english_US, esperanto,
+                       french, german_1996, italian, spanish,
+
+                       -- *** Declarative drawing
+                       (|||), (===), (***), hcat, vcat,
+
+                       -- * Testing
+                       GRec,
+                       recordGame,
+                       readRecord,
+                       testGame,
+                       setupGame,
+                       narrateGame,
+
+                       -- * Transformers
+                       GameIO(..),
+                       Test(..),
+                       Narrate(..)
+
+                       -- | A quick and dirty way to have /hot reload/
+                       -- (autorestarting your game when source files change)
+                       -- is illustrated in @example/MainHotReload.hs@.
+
+                       -- * Cross platform
+                       -- $xcompat
+                     )
+    where
+
+import System.Console.ANSI
+import Terminal.Game.Animation
+import Terminal.Game.Draw
+import Terminal.Game.Layer.Imperative
+import Terminal.Game.Layer.Object as O
+import Terminal.Game.Layer.Object.IO ( cleanAndExit )
+import Terminal.Game.Plane
+import Terminal.Game.Random
+import Text.LineBreak
+
+import qualified Control.Monad as CM
+
+-- $origins
+-- Placing a plane is sometimes more convenient if the coordinates origin
+-- is a corner other than top-left (e.g. “Paste this plane one row from
+-- bottom-left corner”). These combinators — meant to be used instead of '%'
+-- — allow you to do so. Example:
+--
+-- @
+-- prova :: Plane
+-- prova = let rect = box 6 3  \'.\'
+--             letters = word "ab"
+--         in            rect &
+--            (1, 1) %.> letters         -- start from bottom-right
+--
+--     -- λ> putStr (planePaper prova)
+--     -- ......
+--     -- ......
+--     -- ....ab
+-- @
+
+-- $xcompat
+-- Good practices for cross-compatibility:
+--
+-- * choose game dimensions of no more than __24 rows__ and __80 columns__.
+--   This ensures compatibility with the trickiest terminals (i.e. Win32
+--   console);
+--
+-- * use __ASCII characters__ only. Again this is for Win32 console
+--   compatibility, until
+--   [this GHC bug](https://gitlab.haskell.org/ghc/ghc/issues/7593) gets
+--   fixed;
+--
+-- * employ colour sparingly: as some users will play your game in a
+--   light-background terminal and some in a dark one, choose only colours
+--   that go well with either (blue, red, etc.);
+--
+-- * some terminals/multiplexers (i.e. tmux) do not make a distinction
+--   between vivid/dull; do not base your game mechanics on that
+--   difference.
+
+-- | /Usable/ terminal display size (on Win32 console the last line is
+-- set aside for input). Throws 'CannotGetDisplaySize' on error.
+displaySize :: IO Dimensions
+displaySize = O.displaySizeErr
+
+-- | Check if terminal can accomodate 'Dimensions', otherwise throws
+-- 'DisplayTooSmall' with a helpful message for the player.
+assertTermDims :: Width -> Height -> IO ()
+assertTermDims dw dh =
+            clearScreen >>
+            setCursorPosition 0 0 >>
+            displaySizeErr >>= \ads ->
+            CM.when (isSmaller ads)
+                    (throwExc $ DisplayTooSmall (dw, dh) ads)
+    where
+          isSmaller :: Dimensions -> Bool
+          isSmaller (ww, wh) = ww < dw || wh < dh

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Animation.hs

@@ -0,0 +1,33 @@
+-------------------------------------------------------------------------------
+-- Animation
+-- 2018 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+-- {-# LANGUAGE DeriveGeneric #-}
+-- {-# LANGUAGE DefaultSignatures #-}
+-- {-# LANGUAGE StandaloneDeriving #-}
+-- {-# LANGUAGE FlexibleInstances #-}
+
+module Terminal.Game.Animation (module Terminal.Game.Animation,
+                                module T
+                               ) where
+
+import Terminal.Game.Plane
+
+import Control.Timer.Tick as T
+
+-- import Data.Serialize
+
+-- import qualified Data.ByteString as BS
+-- import qualified Data.Bifunctor as BF
+
+-- | An @Animation@ is a series of timed time-separated 'Plane's.
+type Animation = T.Timed Plane
+
+-- | Creates an 'Animation'.
+creaAnimation :: [(Integer, Plane)] -> Animation
+creaAnimation ips = creaTimedRes (Times 1 Elapse) ips
+
+-- | Creates a looped 'Animation'.
+creaLoopAnimation :: [(Integer, Plane)] -> Animation
+creaLoopAnimation ips = creaTimedRes AlwaysLoop ips

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Character.hs

@@ -0,0 +1,43 @@
+module Terminal.Game.Character where
+
+import Data.Char        as C
+import Text.Unidecode   as D
+import System.IO.Unsafe as U
+
+
+import Terminal.Game.Utils
+
+-- Non ASCII character still cause crashes on Win32 console (see this
+-- report: https://gitlab.haskell.org/ghc/ghc/issues/7593 ).
+-- We provide a function to substitute them when playing on Win32
+-- console, with another appropriate chatacter.
+
+win32SafeChar :: Char -> Char
+win32SafeChar c | areWeWin32 = toASCII c
+                | otherwise  = c
+    where
+          areWeWin32 :: Bool
+          areWeWin32 = unsafePerformIO isWin32Console
+
+-- ANCILLARIES --
+
+toASCII :: Char -> Char
+toASCII c | C.isAscii c         = c
+          | Just cm <- lu       = cm    -- hand-made substitution
+          | [cu] <- unidecode c = cu    -- unidecode
+          | otherwise           = '?'   -- all else failing
+    where
+          lu = lookup c subDictionary
+
+subDictionary :: [(Char, Char)]
+subDictionary = [ -- various open/close quotes
+                  ('«', '<'),
+                  ('»', '>'),
+                  ('“', '\''),
+                  ('”', '\''),
+                  ('‘', '\''),
+                  ('’', '\''),
+
+                  -- typographical marks
+                  ('—', '-') ]
+

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Draw.hs

@@ -0,0 +1,255 @@
+-------------------------------------------------------------------------------
+-- Print convenience functions
+-- 2017 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+-- Drawing primitives. If not stated otherwise (textbox, etc.), ' ' are
+-- assumed to be opaque
+
+module Terminal.Game.Draw (module Terminal.Game.Draw,
+                           (F.&)
+                          ) where
+
+import Terminal.Game.Plane
+
+import Text.LineBreak
+
+import qualified Data.Function       as F ( (&) )
+import qualified Data.List           as L
+import qualified System.Console.ANSI as CA
+
+
+-----------
+-- TYPES --
+-----------
+
+-- | A drawing function, usually executed with the help of '%'.
+type Draw = Plane -> Plane
+
+
+-----------------
+-- COMBINATORS --
+-----------------
+
+-- | Pastes one 'Plane' onto another. To be used along with 'F.&'
+-- like this:
+--
+-- @
+--  d :: Plane
+--  d =          blankPlane 100 100  &
+--      (3, 4) % box '_' 3 5         &
+--      (a, b) % cell \'A\' '#' bold
+-- @
+(%) :: Coords -> Plane -> Draw
+cds % p1 = \p2 -> pastePlane p1 p2 cds
+infixl 4 %
+
+-- | Apply style to plane, e.g.
+--
+-- > cell 'w' # bold
+(#) :: Plane -> Draw -> Plane
+p # sf = sf p
+infixl 8 #
+
+-- | Shorthand for sequencing 'Plane's, e.g.
+--
+-- @
+--           firstPlane  &
+--  (3, 4) '%' secondPlane &
+--  (1, 9) '%' thirdPlane
+-- @
+--
+-- is equal to
+--
+-- @
+--  mergePlanes firstPlane [((3,4), secondPlane),
+--                          ((1,9), thirdPlane)]
+-- @
+mergePlanes :: Plane -> [(Coords, Plane)] -> Plane
+mergePlanes p cps = L.foldl' addPlane p cps
+    where
+          addPlane :: Plane -> (Coords, Plane) -> Plane
+          addPlane bp (cs, tp) = bp F.& cs % tp
+
+-- | Place two 'Plane's side-by-side, horizontally.
+(|||) :: Plane -> Plane -> Plane
+(|||) a b = let (wa, ha) = planeSize a
+                (wb, hb) = planeSize b
+            in mergePlanes (blankPlane (wa + wb) (max ha hb))
+                           [((1,1),    a),
+                            ((1,wa+1), b)]
+
+-- | Place two 'Plane's side-by-side, vertically.
+(===) :: Plane -> Plane -> Plane
+(===) a b = let (wa, ha) = planeSize a
+                (wb, hb) = planeSize b
+            in mergePlanes (blankPlane (max wa wb) (ha + hb))
+                           [((1,1),    a),
+                            ((ha+1,1), b)]
+
+-- | @a *** b@ blits @b@ in the centre of @a@.
+(***) :: Plane -> Plane -> Plane
+(***) a b = let (aw, ah) = planeSize a
+                (bw, bh) = planeSize b
+                r = quot (ah - bh) 2 + 1
+                c = quot (aw - bw) 2 + 1
+            in           a F.&
+                (r, c) % b
+
+
+-- | Place a list of 'Plane's side-by-side, horizontally. @error@s on
+-- empty list.
+hcat :: [Plane] -> Plane
+hcat [] = blankPlane 1 1 # makeTransparent ' '
+hcat ps = L.foldl1' (|||) ps
+
+-- | Place a list of 'Plane's side-by-side, vertically. @error@s on
+-- empty list.
+vcat :: [Plane] -> Plane
+vcat [] = blankPlane 1 1 # makeTransparent ' '
+vcat ps = L.foldl1' (===) ps
+
+infixl 6 |||, ===, ***
+
+
+------------
+-- STYLES --
+------------
+
+-- | Set foreground color.
+color :: CA.Color -> CA.ColorIntensity -> Plane -> Plane
+color c i p = mapPlane (colorCell c i) p
+
+-- | Apply bold style to 'Plane'.
+bold :: Plane -> Plane
+bold p = mapPlane boldCell p
+
+-- | Swap foreground and background colours of 'Plane'.
+invert :: Plane -> Plane
+invert p = mapPlane reverseCell p
+
+
+
+-------------
+-- DRAWING --
+-------------
+
+-- | A box of dimensions @w h@.
+box :: Width -> Height -> Char -> Plane
+box w h chr = seqCellsDim w h cells
+    where
+          cells = [((r, c), chr) | r <- [1..h], c <- [1..w]]
+
+-- | A 1×1 @Plane@.
+cell :: Char -> Plane
+cell ch = box 1 1 ch
+
+-- | @1xn@ 'Plane' with a word in it. If you need to import multiline
+-- ASCII art, check 'stringPlane' and 'stringPlaneTrans'.
+word :: String -> Plane
+word w = seqCellsDim (L.genericLength w) 1 cells
+    where
+          cells = zip (zip (repeat 1) [1..]) w
+
+-- opaque :: Plane -> Plane
+-- opaque p = pastePlane p (box ' ' White w h) (1, 1)
+--     where
+--           (w, h) = pSize p
+
+-- | A text-box. Assumes @' '@s are transparent.
+textBox :: Width -> Height -> String -> Plane
+textBox w h cs = frameTrans w h (textBoxLiquid w cs)
+
+-- | Like 'textBox', but tall enough to fit @String@.
+textBoxLiquid :: Width -> String -> Plane
+textBoxLiquid w cs = textBoxGeneralLiquid Nothing w cs
+
+-- | As 'textBox', but hypenated. Example:
+--
+-- @
+-- (normal textbox)                        (hyphenated textbox)
+-- Rimasi un po’ a meditare nel buio       Rimasi un po’ a meditare nel buio
+-- velato appena dal barlume azzurrino     velato appena dal barlume azzurrino
+-- del fornello a gas, su cui              del fornello a gas, su cui sobbol-
+-- sobbolliva quieta la pentola.           liva quieta la pentola.
+-- @
+--
+-- Notice how in the right box /sobbolliva/ is broken in two. This
+-- can be useful and aesthetically pleasing when textboxes are narrow.
+textBoxHyphen :: Hyphenator -> Width -> Height -> String -> Plane
+textBoxHyphen hp w h cs = frameTrans w h (textBoxHyphenLiquid hp w cs)
+
+-- | As 'textBoxLiquid', but hypenated.
+textBoxHyphenLiquid :: Hyphenator -> Width -> String -> Plane
+textBoxHyphenLiquid h w cs = textBoxGeneralLiquid (Just h) w cs
+
+textBoxGeneralLiquid :: Maybe Hyphenator -> Width -> String -> Plane
+textBoxGeneralLiquid mh w cs = transparent
+    where
+          -- hypenathion
+          bf  = BreakFormat (fromIntegral w) 4 '-' mh
+          hcs = breakStringLn bf cs
+          h   = L.genericLength hcs
+
+          f :: [String] -> [(Coords, Char)]
+          f css = concatMap (uncurry rf) (zip [1..] css)
+              where rf :: Int -> String -> [(Coords, Char)]
+                    rf cr ln = zip (zip (repeat cr) [1..]) ln
+
+          out         = seqCellsDim w h (f hcs)
+          transparent = makeTransparent ' ' out
+
+
+----------------------------
+-- ADDITIONAL COMBINATORS --
+----------------------------
+
+-- Coords as if origin were @ bottom-right
+recipCoords :: Coords -> Plane -> Plane -> Coords
+recipCoords (r, c) p p1 =
+            let (pw, ph) = planeSize p
+                (p1w, p1h) = planeSize p1
+                r' = ph-p1h-r+2
+                c' = pw-p1w-c+2
+            in (r', c')
+
+-- | Pastes a plane onto another (origin: top-right).
+(%^>) :: Coords -> Plane -> Draw
+(r, c) %^> p1 = \p ->
+            let (_, c') = recipCoords (r, c) p p1
+            in p F.& (r, c') % p1
+
+-- | Pastes a plane onto another (origin: bottom-left).
+(%.<) :: Coords -> Plane -> Draw
+(r, c) %.< p1 = \p ->
+            let (r', _) = recipCoords (r, c) p p1
+            in p F.& (r', c) % p1
+
+-- | Pastes a plane onto another (origin: bottom-right).
+(%.>) :: Coords -> Plane -> Draw
+cs %.> p1 = \p ->
+            let (r', c') = recipCoords cs p p1
+            in p F.& (r', c') % p1
+
+infixl 4 %^>
+infixl 4 %.<
+infixl 4 %.>
+
+
+-----------------
+-- ANCILLARIES --
+-----------------
+
+seqCellsDim :: Width -> Height -> [(Coords, Char)] -> Plane
+seqCellsDim w h cells = seqCells (blankPlane w h) cells
+
+seqCells :: Plane -> [(Coords, Char)] -> Plane
+seqCells p cells = updatePlane p (map f cells)
+    where
+          f (cds, chr) = (cds, creaCell chr)
+
+-- paste plane on a blank one, and make ' ' transparent
+frameTrans :: Width -> Height -> Plane -> Plane
+frameTrans w h p = let bt = makeTransparent ' ' (blankPlane w h)
+                   in bt F.& (1, 1) % p
+

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Imperative.hs

@@ -0,0 +1,269 @@
+-------------------------------------------------------------------------------
+-- Layer 1 (imperative), as per
+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
+-- 2019 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+{-# Language ScopedTypeVariables #-}
+{-# Language RankNTypes #-}
+
+module Terminal.Game.Layer.Imperative where
+
+import Terminal.Game.Draw
+import Terminal.Game.Layer.Object
+
+import qualified Control.Concurrent as CC
+import qualified Control.Exception as E
+import qualified Control.Monad as CM
+import qualified Control.Monad.Trans          as T
+import qualified Data.Bool as B
+import qualified Data.List as D
+import qualified System.IO as SI
+
+import Terminal.Game.Plane
+
+type Game s = GameT IO s
+
+-- | Game definition datatype, parametrised on your gamestate. The two most
+-- important elements are the function dealing with logic and the drawing
+-- one. Check @alone@ demo (@cabal run -f examples alone@) to see a simple
+-- game in action.
+data GameT m s =
+        Game { gTPS           :: TPS,
+                    -- ^ Game speed in ticks per second. You do not
+                    -- need high values, since the 2D canvas is coarse
+                    -- (e.g. 13 TPS is enough for action games).
+               gInitState     :: s,   -- ^ Initial state of the game.
+               gLogicFunction :: GEnv -> s -> Event -> m s,
+                         -- ^ Logic function.
+               gDrawFunction  :: GEnv -> s -> Plane,
+                         -- ^ Draw function. Just want to blit your game
+                         -- in the middle? Check 'centerFull'.
+               gQuitFunction  :: s -> Bool
+                         -- ^ /Should I quit?/ function.
+                                      }
+
+-- | A blank plane as big as the terminal.
+blankPlaneFull :: GEnv -> Plane
+blankPlaneFull e = uncurry blankPlane (eTermDims e)
+
+-- | Blits plane in the middle of terminal.
+--
+-- @
+--   draw :: GEnv -> MyState -> Plane
+--   draw ev s =
+--       centerFull ev $
+--         ⁝
+-- @
+centerFull :: GEnv -> Plane -> Plane
+centerFull e p = blankPlaneFull e *** p
+
+-- | Entry point for the game execution, should be called in @main@.
+--
+-- You __must__ compile your programs with @-threaded@; if you do not do
+-- this the game will crash at start-up. Just add:
+--
+-- @
+-- ghc-options:      -threaded
+-- @
+--
+-- in your @.cabal@ file and you will be fine!
+--
+-- Need to inspect state on exit? Check 'playGameS'.
+playGame :: Game s -> IO ()
+playGame g = () <$ playGameT T.liftIO g
+
+playGameT :: Monad m => (forall m1 a. T.MonadIO m1 => m a -> m1 a) -> GameT m s -> IO s
+playGameT trans g = runGameGeneral trans g
+
+-- | As 'playGame', but do not discard state.
+playGameS :: Game s -> IO s
+playGameS g = playGameT T.liftIO g
+
+-- | Tests a game in a /pure/ environment. Aims to accurately emulate 'GEnv'
+-- changes (screen size, FPS) too.
+testGame :: GameT Test s -> GRec -> s
+testGame g ts = fst $ runTest (runGameGeneral id g) ts
+
+-- | As 'testGame', but returns 'Game' instead of a bare state.
+-- Useful to fast-forward (e.g.: skip menus) before invoking 'playGame'.
+setupGame :: GameT Test s -> GRec -> GameT Test s
+setupGame g ts = let s' = testGame g ts
+                 in g { gInitState = s' }
+                 -- xx qua messi solo [Event]?
+
+-- | Similar to 'testGame', runs the game given a 'GRec'. Unlike
+-- 'testGame', the playthrough will be displayed on screen. Useful when a
+-- test fails and you want to see how.
+--
+-- See this in action with  @cabal run -f examples alone-playback@.
+--
+-- Notice that 'GEnv' will be provided at /run-time/, and not
+-- record-time; this can make emulation slightly inaccurate if — e.g. —
+-- you replay the game on a smaller terminal than the one you recorded
+-- the session on.
+narrateGame :: GameT Narrate s -> GRec -> IO s
+narrateGame g e = runReplay (runGameGeneral id g) e
+
+-- | Play as in 'playGame' and write the session to @file@. Useful to
+-- produce input for 'testGame' and 'narrateGame'. Session will be
+-- recorded even if an exception happens while playing.
+recordGame :: GameT Record s -> FilePath -> IO ()
+recordGame g fp =
+        E.bracket
+          (CC.newMVar igrec)
+          (\ve -> writeRec fp ve)
+          (\ve -> () <$ runRecord (runGameGeneral id g) ve)
+
+data Config = Config { cMEvents :: CC.MVar [Event],
+                       cTPS     :: TPS }
+
+runGameGeneral :: forall s m1 m. (Monad m1, MonadGameIO m)
+               => (forall a. m1 a -> m a)
+               -> GameT m1 s
+               -> m s
+runGameGeneral trans (Game tps s lf df qf) =
+            -- init
+            setupDisplay    >>
+            startEvents tps >>= \(InputHandle ve ts) ->
+            displaySizeErr  >>= \ds -> do
+
+            -- do it!
+            let c = Config ve tps
+            s' <- (game c ds) `onException` (stopEvents ts >> shutdownDisplay)
+            stopEvents ts
+            return s'
+    where
+          game :: MonadGameIO m => Config -> Dimensions -> m s
+          game c wds = gameLoop trans c s lf df qf
+                                Nothing wds
+                                (creaFPSCalc tps)
+
+-- | Wraps an @IO@ computation so that any 'ATGException' or 'error' gets
+-- displayed along with a @\<press any key to quit\>@ prompt.
+-- Some terminals shut-down immediately upon program end; adding
+-- @errorPress@ to 'playGame' makes it easier to beta-test games on those
+-- terminals.
+errorPress :: IO a -> IO a
+errorPress m = E.catches m [E.Handler errorDisplay,
+                            E.Handler atgDisplay]
+    where
+          errorDisplay :: E.ErrorCall -> IO a
+          errorDisplay (E.ErrorCallWithLocation cs l) = report $
+              putStrLn (cs ++ "\n\n")        >>
+              putStrLn "Stack trace info:\n" >>
+              putStrLn l
+
+          atgDisplay :: ATGException -> IO a
+          atgDisplay e = report $ print e
+
+          report :: IO () -> IO a
+          report wm =
+              putStrLn "ERROR REPORT\n"                >>
+              wm                                       >>
+              putStrLn "\n\n <Press any key to quit>"  >>
+              SI.hSetBuffering SI.stdin SI.NoBuffering >>
+              getChar                                  >>
+              errorWithoutStackTrace "errorPress"
+
+
+-----------
+-- LOGIC --
+-----------
+
+-- from http://www.loomsoft.net/resources/alltut/alltut_lesson6.htm
+gameLoop :: (Monad m1, MonadGameIO m) =>
+            (forall a. m1 a -> m a) ->
+            Config            -> -- event source
+            s                 -> -- state
+            (GEnv ->
+             s -> Event -> m1 s) -> -- logic function
+            (GEnv ->
+             s -> Plane)      -> -- draw function
+            (s -> Bool)       -> -- quit? function
+            Maybe Plane       -> -- last blitted screen
+            Dimensions        -> -- Term dimensions
+            FPSCalc           -> -- calculate fps
+            m s
+gameLoop trans c s lf df qf opln td fps =
+
+        -- quit?
+        checkQuit qf s >>= \qb ->
+        if qb
+          then return s
+        else
+
+        -- fetch events (if any)
+        pollEvents (cMEvents c) >>= \es ->
+
+        -- no events? skip everything
+        if null es
+          then sleepABit (cTPS c)               >>
+               gameLoop trans c s lf df qf opln td fps
+        else
+
+        displaySizeErr            >>= \td' ->
+
+        -- logic
+        let ge = GEnv td' (calcFPS fps) in
+        trans (stepsLogic s (lf ge) es) >>= \(i, s') ->
+
+        -- no `Tick` events? You do not need to blit, just update state
+        if i == 0
+          then gameLoop trans c s' lf df qf opln td fps
+        else
+
+        -- FPS calc
+        let fps' = addFPS i fps in
+
+        -- clear screen if resolution changed
+        let resc = td /= td' in
+        CM.when resc clearDisplay >>
+
+        -- draw
+        let opln' | resc = Nothing -- res changed? restart double buffering
+                  | otherwise = opln
+            npln = df ge s' in
+
+        blitPlane opln' npln >>
+
+        gameLoop trans c s' lf df qf (Just npln) td' fps'
+
+-- Int = number of `Tick` events
+stepsLogic :: Monad m => s -> (s -> Event -> m s) -> [Event] -> m (Integer, s)
+stepsLogic s lf es = do
+  let ies = D.genericLength . filter isTick $ es
+  res <- CM.foldM lf s es
+  return (ies, res)
+ where
+  isTick Tick = True
+  isTick _    = False
+
+-------------------------------------------------------------------------------
+-- Frame per Seconds
+
+data FPSCalc = FPSCalc [Integer] TPS
+    -- list with number of `Ticks` processed at each blit and expected
+    -- FPS (i.e. TPS)
+
+-- the size of moving average will be TPS (that simplifies calculations)
+creaFPSCalc :: TPS -> FPSCalc
+creaFPSCalc tps = FPSCalc (D.genericReplicate tps {- (tps*2) -} 1) tps
+    -- tps*1: size of thw window in **blit actions** (not tick actions!)
+    --        so keeping it small should be responsive and non flickery
+    --        at the same time!
+
+-- add ticks
+addFPS :: Integer -> FPSCalc -> FPSCalc
+addFPS nt (FPSCalc (_:fps) tps) = FPSCalc (fps ++ [nt]) tps
+addFPS _ (FPSCalc [] _) = error "addFPS: empty list."
+
+calcFPS :: FPSCalc -> Integer
+calcFPS (FPSCalc fps tps) =
+        let ts = sum fps
+            ds = D.genericLength fps
+        in roundQuot (tps * ds) ts
+    where
+          roundQuot :: Integer -> Integer -> Integer
+          roundQuot a b = let (q, r) = quotRem a b
+                          in q + B.bool 0 1 (r > div b 2)

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Object.hs

@@ -0,0 +1,30 @@
+-------------------------------------------------------------------------------
+-- Layer 2 (mockable IO), as per
+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
+-- 2019 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+module Terminal.Game.Layer.Object ( module Export ) where
+
+import Terminal.Game.Layer.Object.Interface as Export
+import Terminal.Game.Layer.Object.GameIO    as Export
+import Terminal.Game.Layer.Object.Narrate   as Export
+import Terminal.Game.Layer.Object.Primitive as Export
+import Terminal.Game.Layer.Object.Record    as Export
+import Terminal.Game.Layer.Object.Test      as Export
+
+-- DESIGN NOTES --
+
+-- The classes are described in 'Interface'.
+
+-- The implemented monads are four:
+--     - GameIO (via MonadIO): playing the game
+--     - Test: testing the game in a pure manner
+--     - Record: playing the game and record the Events in a file
+--     - Replay: replay a game using a set of Events.
+--
+-- The last two monads (Record/Replay) take advantage of "overlapping
+-- instances". Instead of reimplementing most of what happens in MonadIO,
+-- they'll just touch the classes from interface which behaviour they
+-- will modify; being more specific, they will be chosen instead of plain
+-- IO.

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Object/GameIO.hs

@@ -0,0 +1,21 @@
+-------------------------------------------------------------------------------
+-- Layer 2 (mockable IO), as per
+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
+-- 2019 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+
+module Terminal.Game.Layer.Object.GameIO where
+
+import qualified Control.Monad.Catch          as MC
+import qualified Control.Monad.Trans          as T
+
+
+newtype GameIO a = GameIO { runGIO :: IO a }
+                 deriving (Functor, Applicative, Monad,
+                           T.MonadIO,
+                           MC.MonadThrow, MC.MonadCatch, MC.MonadMask)
+
+

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Object/IO.hs

@@ -0,0 +1,291 @@
+-------------------------------------------------------------------------------
+-- Layer 2 (mockable IO), as per
+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
+-- 2019 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+
+module Terminal.Game.Layer.Object.IO where
+
+import Terminal.Game.Utils
+
+import Terminal.Game.Layer.Object.Interface
+import Terminal.Game.Layer.Object.Primitive
+import Terminal.Game.Plane
+
+import qualified Control.Concurrent           as CC
+import qualified Control.Monad                as CM
+import qualified Control.Monad.Catch          as MC
+import qualified Control.Monad.Trans          as T
+import qualified Data.List.Split              as LS
+import qualified System.Clock                 as SC
+import qualified System.Console.ANSI          as CA
+import qualified System.Console.Terminal.Size as TS
+import qualified System.IO                    as SI
+
+-- Most General MonadIO operations.
+
+----------------
+-- Game input --
+----------------
+
+instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadInput m where
+    startEvents tps = T.liftIO $ startIOInput tps
+    pollEvents ve = T.liftIO $ CC.swapMVar ve []
+    stopEvents ts = T.liftIO $ stopEventsIO ts
+
+-- filepath = logging
+startIOInput :: TPS -> IO InputHandle
+startIOInput tps =
+            SI.hSetBuffering SI.stdin SI.NoBuffering  >>
+            SI.hSetBuffering SI.stdout SI.NoBuffering >>
+            SI.hSetEcho SI.stdin False                >>
+                -- all the buffering settings has to happen
+                -- at the top of startIOInput. If i move
+                -- them to display, you need to press enter
+                -- before playing the game on some machines.
+
+            -- event and log variables
+            CC.newMVar [] >>= \ve ->
+
+            getTimeTick tps               >>= \it ->
+            CC.forkIO (addTick ve tps it) >>= \te ->
+            CC.forkIO (addKeypress ve)    >>= \tk ->
+            return (InputHandle ve [te, tk])
+
+-- a precise timer, not based on `threadDelay`
+type Elapsed = Integer -- in `Ticks`
+
+-- elapsed from Epoch in ticks
+getTimeTick :: TPS -> IO Elapsed
+getTimeTick tps =
+        getTime >>= \tm ->
+        let ns = 10 ^ (9 :: Integer)
+            t1 = quot ns tps in
+        return (quot tm t1)
+
+-- mr: maybe recording
+addTick :: CC.MVar [Event] -> TPS -> Elapsed -> IO ()
+addTick ve tps el =
+                -- precise timing. With `treadDelay`, on finer TPS,
+                -- ticks take too much (check threadDelay doc).
+                getTimeTick tps                   >>= \t ->
+                CM.replicateM_ (fromIntegral $ t-el)
+                               (addEvent ve Tick) >>
+
+                -- sleep some
+                sleepABit tps >>
+                addTick ve tps t
+
+-- get action char
+-- mr: maybe recording
+addKeypress :: CC.MVar [Event] -> IO ()
+addKeypress ve = -- vedi platform-dep/
+                 inputCharTerminal        >>= \c ->
+                 addEvent ve (KeyPress c) >>
+                 addKeypress ve
+
+-- mr: maybe recording
+addEvent :: CC.MVar [Event] -> Event -> IO ()
+addEvent ve e = vf ve
+    where
+          vf d = CC.modifyMVar_ d (return . (++[e]))
+
+stopEventsIO :: [CC.ThreadId] -> IO ()
+stopEventsIO ts = mapM_ CC.killThread ts
+
+-----------------
+-- Game timing --
+-----------------
+
+instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadTimer m where
+    getTime = T.liftIO $ SC.toNanoSecs <$> SC.getTime SC.Monotonic
+    sleepABit tps = T.liftIO $
+        CC.threadDelay (fromIntegral $ quot oneTickSec (tps*10))
+
+--------------------
+-- Error handling --
+--------------------
+
+instance {-# OVERLAPS #-}
+        (Monad m, T.MonadIO m, MC.MonadMask m, MC.MonadThrow m) =>
+          MonadException m where
+    cleanUpErr m c = MC.finally m c
+    onException m c = MC.onException m c
+    throwExc t = MC.throwM t
+
+-----------
+-- Logic --
+-----------
+
+instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) =>
+          MonadLogic m where
+    checkQuit fb s = return (fb s)
+
+-------------
+-- Display --
+-------------
+
+instance {-# OVERLAPS #-} (Monad m, T.MonadIO m) => MonadDisplay m where
+    setupDisplay = T.liftIO initPart
+    clearDisplay = T.liftIO clearScreen
+    displaySize = T.liftIO displaySizeIO
+    blitPlane mp p = T.liftIO (blitPlaneIO mp p)
+    shutdownDisplay = T.liftIO cleanAndExit
+
+displaySizeIO :: IO (Maybe Dimensions)
+displaySizeIO =
+        TS.size        >>= \ts ->
+            -- cannot use ansi-terminal, on Windows you get
+            -- "ConsoleException 87" (too much scrolling)
+            -- and it does not work for mintty and it is
+            -- inefficient as it gets (attempts to scroll past
+            -- bottom right)
+        isWin32Console >>= \bw ->
+
+        return (fmap (f bw) ts)
+    where
+          f :: Bool -> TS.Window Int -> Dimensions
+          f wbw (TS.Window h w) =
+                let h' | wbw       = h - 1
+                       | otherwise = h
+                in (w, h')
+
+-- pn: new plane, po: old plane
+-- wo, ho: dimensions of the terminal. If they change, reinit double buffering
+blitPlaneIO :: Maybe Plane -> Plane -> IO ()
+blitPlaneIO mpo pn =
+
+        -- remember that Nothing will be passed:
+        -- - at the beginning of the game (first blit)
+        -- - when resolution changes (see gameLoop)
+        -- so do not duplicate hasResChanged checks here!
+
+        -- old plane
+        let
+            (pw, ph) = planeSize pn
+            bp  = blankPlane pw ph
+            po  = pastePlane (maybe bp id mpo) bp (1, 1)
+        in
+
+        -- new plane
+        let pn'  = pastePlane pn bp (1, 1)
+        in
+
+            -- trimming is foundamental, as blitMap could otherwise print
+            -- outside terminal boundaries and scroll to its death
+            -- (error 87 on Win32 console).
+
+        CA.setSGR [CA.Reset] >>
+        blitMap po pn'
+
+
+-----------------
+-- ANCILLARIES --
+-----------------
+
+initPart :: IO ()
+initPart = -- check thread support
+           CM.unless CC.rtsSupportsBoundThreads
+                     (error errMes)             >>
+
+           -- initial setup/checks
+           CA.hideCursor >>
+
+           -- text encoding
+           SI.mkTextEncoding "UTF-8//TRANSLIT" >>= \te ->
+           SI.hSetEncoding SI.stdout te        >>
+
+           clearScreen
+    where
+          errMes = unlines
+            ["\nError: you *must* compile this program with -threaded!",
+             "Just add",
+             "",
+             "    ghc-options:      -threaded",
+             "",
+             "in your .cabal file (executable section) and you will be fine!"]
+
+-- clears screen
+clearScreen :: IO ()
+clearScreen = CA.setCursorPosition 0 0 >>
+              CA.setSGR [CA.Reset]     >>
+              displaySizeErr           >>= \(w, h) ->
+              CM.replicateM_ (fromIntegral $ w*h) (putChar ' ')
+
+cleanAndExit :: IO ()
+cleanAndExit = CA.setSGR [CA.Reset]     >>
+               CA.clearScreen           >>
+               CA.setCursorPosition 0 0 >>
+               CA.showCursor
+
+-- plane
+blitMap :: Plane -> Plane -> IO ()
+blitMap po pn =
+            CM.when (planeSize po /= planeSize pn)
+                    (error "blitMap: different plane sizes")      >>
+            CA.setCursorPosition 0 0                              >>
+                -- setCursorPosition is *zero* based!
+            blitToTerminal (0, 0) (orderedCells po) (orderedCells pn)
+
+orderedCells :: Plane -> [[Cell]]
+orderedCells p = LS.chunksOf (fromIntegral w) cells
+    where
+          cells  = map snd $ assocsPlane p
+          (w, _) = planeSize p
+
+
+-- ordered sequence of cells, both old and new, like they were a String to
+-- print to screen.
+-- Coords: initial blitting position
+-- Remember that this Column is *zero* based
+blitToTerminal :: Coords -> [[Cell]] -> [[Cell]] -> IO ()
+blitToTerminal (rr, rc) ocs ncs = CM.foldM_ blitLine rr oldNew
+    where
+          oldNew :: [[(Cell, Cell)]]
+          oldNew = zipWith zip ocs ncs
+
+          -- row = previous row
+          blitLine :: Row -> [(Cell, Cell)] -> IO Row
+          blitLine pr ccs =
+                CM.foldM_ blitCell 0 ccs               >>
+                -- have to use setCursorPosition (instead of nextrow) b/c
+                -- on win there is an auto "go-to-next-line" when reaching
+                -- column end and on win it does not do so
+                let wr = pr + 1 in
+                CA.setCursorPosition (fromIntegral wr)
+                                     (fromIntegral rc) >>
+                return wr
+
+          -- k is "spaces to skip"
+          blitCell :: Int -> (Cell, Cell) -> IO Int
+          blitCell k (clo, cln)
+                | cln == clo = return (k+1)
+                | otherwise  = moveIf k         >>= \k' ->
+                               putCellStyle cln >>
+                               return k'
+
+          moveIf :: Int -> IO Int
+          moveIf k | k == 0    = return k
+                   | otherwise = CA.cursorForward k >>
+                                 return 0
+
+putCellStyle :: Cell -> IO ()
+putCellStyle c = CA.setSGR ([CA.Reset] ++ sgrb ++ sgrr ++ sgrc) >>
+                 putChar (cellChar c)
+    where
+          sgrb | isBold c  = [CA.SetConsoleIntensity CA.BoldIntensity]
+               | otherwise = []
+
+          sgrr | isReversed c = [CA.SetSwapForegroundBackground True]
+               | otherwise    = []
+
+          sgrc | Just (k, i) <- cellColor c = [CA.SetColor CA.Foreground i k]
+               | otherwise                  = []
+
+oneTickSec :: Integer
+oneTickSec = 10 ^ (6 :: Integer)

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Object/Interface.hs

@@ -0,0 +1,90 @@
+-------------------------------------------------------------------------------
+-- Layer 2 (mockable IO), as per
+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
+-- 2019 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Terminal.Game.Layer.Object.Interface where
+
+import Terminal.Game.Plane
+import Terminal.Game.Layer.Object.Primitive
+
+import qualified Control.Concurrent as CC
+import qualified Control.Monad.Catch as MC
+
+-------------------------------------------------------------------------------
+-- mtl interface for game
+
+type MonadGameIO m = (MonadInput m, MonadTimer m,
+                      MonadException m, MonadLogic m,
+                      MonadDisplay m)
+
+data InputHandle = InputHandle
+            { ihKeyMVar     :: CC.MVar [Event],
+              ihOpenThreads :: [CC.ThreadId] }
+
+class Monad m => MonadInput m where
+    startEvents :: TPS -> m InputHandle
+    pollEvents  :: CC.MVar [Event] -> m [Event]
+    stopEvents :: [CC.ThreadId] -> m ()
+
+class Monad m => MonadTimer m where
+    getTime :: m Integer     -- to nanoseconds
+    sleepABit :: TPS -> m () -- Given TPS, sleep a fracion of a single
+                             -- Tick.
+
+-- if a fails, do b (useful for cleaning up)
+class Monad m => MonadException m where
+    cleanUpErr :: m a -> m b -> m a
+    onException :: m a -> m b -> m a
+    throwExc :: ATGException -> m a
+
+class Monad m => MonadLogic m where
+    -- decide whether it's time to quit
+    checkQuit :: (s -> Bool) -> s -> m Bool
+
+class Monad m => MonadDisplay m where
+    setupDisplay :: m ()
+    clearDisplay :: m ()
+    displaySize :: m (Maybe Dimensions)
+    blitPlane :: Maybe Plane -> Plane -> m ()
+    shutdownDisplay :: m ()
+
+displaySizeErr :: (MonadDisplay m, MonadException m) => m Dimensions
+displaySizeErr = displaySize >>= \case
+                   Nothing -> throwExc CannotGetDisplaySize
+                   Just d -> return d
+
+-------------------------------------------------------------------------------
+-- Error handling
+
+-- | @ATGException@s are thrown synchronously for easier catching.
+data ATGException = CannotGetDisplaySize
+                  | DisplayTooSmall Dimensions Dimensions
+                        -- ^ Required and actual dimensions.
+
+instance Show ATGException where
+    show CannotGetDisplaySize = "CannotGetDisplaySize"
+    show (DisplayTooSmall (sw, sh) tds) =
+      let colS ww = ww < sw
+          rowS wh = wh < sh
+
+          smallMsg :: Dimensions -> String
+          smallMsg (ww, wh) =
+                let cm = show ww ++ " columns"
+                    rm = show wh ++ " rows"
+                    em | colS ww && rowS wh = cm ++ " and " ++ rm
+                       | colS ww = cm
+                       | rowS wh = rm
+                       | otherwise = "smallMsg: passed correct term size!"
+                in
+                  "This games requires a display of " ++ show sw ++
+                  " columns and " ++ show sh ++ " rows.\n" ++
+                  "Yours only has " ++ em ++ "!\n\n" ++
+                  "Please resize your terminal and restart the game.\n"
+      in "DisplayTooSmall.\n" ++ smallMsg tds
+
+instance MC.Exception ATGException where

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Object/Narrate.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Terminal.Game.Layer.Object.Narrate where
+
+-- Narrate Monad, replay on screen from a GRec
+
+import Terminal.Game.Layer.Object.Interface
+import Terminal.Game.Layer.Object.Primitive
+import Terminal.Game.Layer.Object.IO () -- MonadIo
+
+import qualified Control.Monad.Catch as MC
+import qualified Control.Monad.State as S
+import qualified Control.Monad.Trans as T
+
+
+newtype Narrate a = Narrate (S.StateT GRec IO a)
+                deriving (Functor, Applicative, Monad,
+                          T.MonadIO, S.MonadState GRec,
+                          MC.MonadThrow, MC.MonadCatch, MC.MonadMask)
+
+instance MonadInput Narrate where
+    startEvents fps = T.liftIO $ startEvents fps
+    pollEvents _ = S.state getPolled
+    stopEvents ts = T.liftIO $ stopEvents ts
+
+instance MonadLogic Narrate where
+    checkQuit _ _ = S.gets isOver
+
+runReplay :: Narrate a -> GRec -> IO a
+runReplay (Narrate s) k = S.evalStateT s k

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Object/Primitive.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+
+module Terminal.Game.Layer.Object.Primitive where
+
+import Terminal.Game.Plane
+
+import qualified GHC.Generics as G
+import qualified Data.ByteString as BS
+import qualified Data.Serialize as Z
+import qualified Data.Sequence as S
+import qualified Test.QuickCheck as Q
+
+-------------------------------------------------------------------------------
+-- Assorted API types
+
+-- | The number of 'Tick's fed each second to the logic function;
+-- constant on every machine. /Frames/ per second might be lower
+-- (depending on drawing function onerousness, terminal refresh rate,
+-- etc.).
+type TPS = Integer
+
+-- | The number of frames blit to terminal per second. Frames might be
+-- dropped, but game speed will remain constant. Check @balls@
+-- (@cabal run -f examples balls@) to see how to display FPS.
+-- For obvious reasons (blits would be wasted) @max FPS = TPS@.
+type FPS = Integer
+
+-- | An @Event@ is a 'Tick' (time passes) or a 'KeyPress'.
+data Event = Tick
+           | KeyPress Char
+           deriving (Show, Eq, G.Generic)
+instance Z.Serialize Event where
+
+instance Q.Arbitrary Event where
+  arbitrary = Q.oneof [ pure Tick,
+                        KeyPress <$> Q.arbitrary ]
+
+-- | Game environment with current terminal dimensions and current display
+-- rate.
+data GEnv = GEnv { eTermDims :: Dimensions,
+                        -- ^ Current terminal dimensions.
+                   eFPS :: FPS
+                        -- ^ Current blitting rate.
+                       }
+    deriving (Show, Eq)
+
+-------------------------------------------------------------------------------
+-- GRec record/replay game typs
+
+-- | Opaque data type with recorded game input, for testing purposes.
+data GRec = GRec { aPolled :: S.Seq [Event],
+                                -- Seq. of polled events
+                   aTermSize :: S.Seq (Maybe Dimensions) }
+                                -- Seq. of polled termdims
+        deriving (Show, Eq, G.Generic)
+instance Z.Serialize GRec where
+
+igrec :: GRec
+igrec = GRec S.Empty S.Empty
+
+addDims :: Maybe Dimensions -> GRec -> GRec
+addDims mds (GRec p s) = GRec p (mds S.<| s)
+
+getDims :: GRec -> (Maybe Dimensions, GRec)
+getDims (GRec p (ds S.:|> d)) = (d, GRec p ds)
+getDims _ = error "getDims: empty Seq"
+    -- Have to use _ or “non exhaustive patterns” warning
+
+addPolled :: [Event] -> GRec -> GRec
+addPolled es (GRec p s) = GRec (es S.<| p) s
+
+getPolled :: GRec -> ([Event], GRec)
+getPolled (GRec (ps S.:|> p) d) = (p, GRec ps d)
+getPolled _ = error "getEvents: empty Seq"
+
+isOver :: GRec -> Bool
+isOver (GRec S.Empty _) = True
+isOver _ = False
+
+-- | Reads a file containing a recorded session.
+readRecord :: FilePath -> IO GRec
+readRecord fp = Z.decode <$> BS.readFile fp >>= \case
+                  Left e  -> error $ "readRecord could not decode: " ++
+                                     show e
+                  Right r -> return r
+
+-- | Convenience function to create a 'GRec' from screen size (constant) plus a list of events. Useful with 'setupGame'.
+createGRec :: Dimensions -> [Event] -> GRec
+createGRec ds es = let l = length es * 2 in
+                   GRec (S.fromList [es])
+                        (S.fromList . replicate l $ Just ds)
+

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Object/Record.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Terminal.Game.Layer.Object.Record where
+
+-- Record Monad, for when I need to play the game and record Events
+-- (keypresses, ticks, screen size, FPS) to a file.
+
+import Terminal.Game.Layer.Object.Interface
+import Terminal.Game.Layer.Object.Primitive
+import Terminal.Game.Layer.Object.IO ()
+
+import qualified Control.Concurrent   as CC
+import qualified Control.Monad.Catch  as MC
+import qualified Control.Monad.Reader as R
+import qualified Control.Monad.Trans  as T -- MonadIO
+import qualified Data.ByteString      as BS
+import qualified Data.Serialize       as S
+
+-- record the key pressed in a game session
+
+newtype Record a = Record (R.ReaderT (CC.MVar GRec) IO a)
+                deriving (Functor, Applicative, Monad,
+                          T.MonadIO, R.MonadReader (CC.MVar GRec),
+                          MC.MonadThrow, MC.MonadCatch, MC.MonadMask)
+
+-- Lifts IO interface, records where necessary
+instance MonadInput Record where
+    startEvents tps = T.liftIO (startEvents tps)
+    pollEvents ve = T.liftIO (pollEvents ve) >>= \es ->
+                    modMRec addPolled es
+    stopEvents ts = T.liftIO (stopEvents ts)
+
+instance MonadDisplay Record where
+    setupDisplay = T.liftIO setupDisplay
+    clearDisplay = T.liftIO clearDisplay
+    displaySize = T.liftIO displaySize >>= \ds ->
+                  modMRec addDims ds
+    blitPlane mp p = T.liftIO (blitPlane mp p)
+    shutdownDisplay = T.liftIO shutdownDisplay
+
+-- logs and passes the value on
+modMRec :: (a -> GRec -> GRec) -> a -> Record a
+modMRec f a = R.ask >>= \mv ->
+              let fmv = CC.modifyMVar_ mv (return . f a) in
+              T.liftIO fmv >>
+              return a
+
+runRecord :: Record a -> CC.MVar GRec -> IO a
+runRecord (Record r) me = R.runReaderT r me
+
+writeRec :: FilePath -> CC.MVar GRec -> IO ()
+writeRec fp vr = CC.readMVar vr                >>= \k ->
+                 BS.writeFile fp (S.encode k)

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Layer/Object/Test.hs

@@ -0,0 +1,78 @@
+-------------------------------------------------------------------------------
+-- Layer 2 (mockable IO), as per
+-- https://www.parsonsmatt.org/2018/03/22/three_layer_haskell_cake.html
+-- 2019 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Terminal.Game.Layer.Object.Test where
+
+-- Test (pure) MonadGame* typeclass implementation for testing purposes.
+
+import Terminal.Game.Layer.Object.Interface
+import Terminal.Game.Layer.Object.Primitive
+
+import qualified Control.Monad.RWS as S
+
+
+-----------
+-- TYPES --
+-----------
+
+data TestEvent = TCleanUpError
+               | TQuitGame
+               | TSetupDisplay
+               | TShutdownDisplay
+               | TStartGame
+               | TStartEvents
+               | TStopEvents
+        deriving (Eq, Show)
+
+-- r: ()
+-- w: [TestEvents]
+-- s: [GTest]
+newtype Test a = Test (S.RWS () [TestEvent] GRec a)
+               deriving (Functor, Applicative, Monad,
+                         S.MonadState GRec,
+                         S.MonadWriter [TestEvent])
+
+runTest :: Test a -> GRec -> (a, [TestEvent])
+runTest (Test m) es = S.evalRWS m () es
+
+
+-----------
+-- CLASS --
+-----------
+
+tconst :: a -> Test a
+tconst a = Test $ return a
+
+mockHandle :: InputHandle
+mockHandle = InputHandle (error "mock handle keyMvar")
+                         (error "mock handle threads")
+
+instance MonadInput Test where
+    startEvents _ = S.tell [TStartEvents] >>
+                    return mockHandle
+    pollEvents _ = S.state getPolled
+    stopEvents _ = S.tell [TStopEvents]
+
+instance MonadTimer Test where
+    getTime = return 1
+    sleepABit _ = return ()
+
+instance MonadException Test where
+    cleanUpErr a _ = S.tell [TCleanUpError] >> a
+    onException a _ = S.tell [TCleanUpError] >> a
+    throwExc e = error . show $ e
+
+instance MonadLogic Test where
+    checkQuit _ _ = S.gets isOver
+
+instance MonadDisplay Test where
+    setupDisplay = () <$ S.tell [TSetupDisplay]
+    clearDisplay = return ()
+    displaySize = Test $ S.state getDims
+    blitPlane _ _ = return ()
+    shutdownDisplay = () <$ S.tell [TShutdownDisplay]

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Plane.hs

@@ -0,0 +1,237 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+-------------------------------------------------------------------------------
+-- Screen datatypes and functions
+-- 2017 Francesco Ariis GPLv3
+-------------------------------------------------------------------------------
+
+-- a canvas where to draw our stuff
+
+module Terminal.Game.Plane where
+
+import Terminal.Game.Character
+
+import qualified Data.Array          as A
+import qualified Data.Bifunctor      as B
+import qualified Data.List.Split     as LS
+import qualified Data.Tuple          as T
+import qualified GHC.Generics        as G
+import qualified System.Console.ANSI as CA
+
+
+----------------
+-- DATA TYPES --
+----------------
+
+-- | 'Row's and 'Column's are 1-based (top-left position is @1 1@).
+type Coords = (Row, Column)
+type Row    = Int
+type Column = Int
+
+-- | Size of a surface in 'Row's and 'Column's.
+type Dimensions = (Width, Height)
+
+-- | Expressed in 'Column's.
+type Width  = Int
+-- | Expressed in 'Row's.
+type Height = Int
+
+type Bold     = Bool
+type Reversed = Bool
+
+-- can be an ASCIIChar or a special, transparent character
+data Cell = CellChar Char Bold
+                     Reversed (Maybe (CA.Color, CA.ColorIntensity))
+          | Transparent
+          deriving (Show, Eq, Ord, G.Generic)
+        -- I found no meaningful speed improvements by making this
+        -- only w/ 1 constructor.
+
+-- | A two-dimensional surface (Row, Column) where to blit stuff.
+newtype Plane = Plane { fromPlane :: A.Array Coords Cell }
+              deriving (Show, Eq, G.Generic)
+        -- Could this be made into an UArray? Nope, since UArray is
+        -- only instanced on Words, Int, Chars, etc.
+
+-------------------------------------------------------------------------------
+-- Plane interface (abstracting Array)
+
+listPlane :: Coords -> [Cell] -> Plane
+listPlane (r, c) cs = Plane $ A.listArray ((1,1), (r, c)) cs
+
+-- | Dimensions or a plane.
+planeSize :: Plane -> Dimensions
+planeSize p = T.swap . snd $ A.bounds (fromPlane p)
+
+assocsPlane :: Plane -> [(Coords, Cell)]
+assocsPlane p = A.assocs (fromPlane p)
+
+elemsPlane :: Plane -> [Cell]
+elemsPlane p = A.elems (fromPlane p)
+
+-- Array.//
+updatePlane :: Plane -> [(Coords, Cell)] -> Plane
+updatePlane (Plane a) kcs = Plane $ a A.// kcs
+
+-- faux map
+mapPlane :: (Cell -> Cell) -> Plane -> Plane
+mapPlane f (Plane a) = Plane $ fmap f a
+
+
+----------
+-- CREA --
+----------
+
+creaCell :: Char -> Cell
+creaCell ch = CellChar chm False False Nothing
+    where
+          chm = win32SafeChar ch
+
+colorCell :: CA.Color -> CA.ColorIntensity -> Cell -> Cell
+colorCell k i (CellChar c b r _) = CellChar c b r (Just (k, i))
+colorCell _ _ Transparent        = Transparent
+
+boldCell :: Cell -> Cell
+boldCell (CellChar c _ r k) = CellChar c True r k
+boldCell Transparent        = Transparent
+
+reverseCell :: Cell -> Cell
+reverseCell (CellChar c b _ k) = CellChar c b True k
+reverseCell Transparent        = Transparent
+
+-- | Creates 'Plane' from 'String', good way to import ASCII
+-- art/diagrams. @error@s on empty string.
+stringPlane :: String -> Plane
+stringPlane t = stringPlaneGeneric Nothing t
+
+-- | Same as 'stringPlane', but with transparent 'Char'.
+-- @error@s on empty string.
+stringPlaneTrans :: Char -> String -> Plane
+stringPlaneTrans c t = stringPlaneGeneric (Just c) t
+
+-- | Creates an empty, opaque 'Plane'.
+blankPlane :: Width -> Height -> Plane
+blankPlane w h = listPlane (h, w) (repeat $ creaCell ' ')
+
+-- | Adds transparency to a plane, matching a given character
+makeTransparent :: Char -> Plane -> Plane
+makeTransparent tc p = mapPlane f p
+    where
+          f cl | cellChar cl == tc = Transparent
+               | otherwise         = cl
+
+-- | Changes every transparent cell in the 'Plane' to an opaque @' '@
+-- character.
+makeOpaque :: Plane -> Plane
+makeOpaque p = let (w, h) = planeSize p
+               in pastePlane p (blankPlane w h) (1, 1)
+
+
+
+-----------
+-- SLICE --
+-----------
+
+-- | Paste one plane over the other at a certain position (p1 gets over p2).
+pastePlane :: Plane -> Plane -> Coords -> Plane
+pastePlane p1 p2 (r, c)
+            | r > h2 || c > w2 = p2
+            | otherwise =
+                let ks = assocsPlane p1
+                    fs = filter (\x -> solid x && inside x) ks
+                    ts = fmap (B.first trasl) fs
+                in updatePlane p2 ts
+    where
+          trasl :: Coords -> Coords
+          trasl (wr, wc) = (wr + r - 1, wc + c - 1)
+
+          -- inside new position, cheaper than first mapping and then
+          -- filtering.
+          inside (wcs, _) =
+                let (r1', c1') = trasl wcs
+                in r1' >= 1 && r1' <= h2 &&
+                   c1' >= 1 && c1' <= w2
+
+          solid (_, Transparent) = False
+          solid _                = True
+
+          (w2, h2)  = planeSize p2
+
+-- | Cut out a plane by top-left and bottom-right coordinates.
+subPlane :: Plane -> Coords -> Coords -> Plane
+subPlane p (r1, c1) (r2, c2)
+        | r1 > r2 || c1 > c2 = err (r1, c1) (r2, c2)
+        | otherwise          =
+            let cs       = assocsPlane p
+                fs       = filter f cs
+                (pw, ph) = planeSize p
+                (w, h)   = (min pw (c2-c1+1), min ph (r2-r1+1))
+            in listPlane (h, w) (map snd fs)
+    where
+          f ((rw, cw), _) = rw >= r1 && rw <= r2 &&
+                            cw >= c1 && cw <= c2
+
+          err p1 p2 = error ("subPlane: top-left point " ++ show p1 ++
+                             " > bottom-right point " ++ show p2 ++ ".")
+
+-------------
+-- INQUIRE --
+-------------
+
+cellChar :: Cell -> Char
+cellChar (CellChar c _ _ _) = c
+cellChar Transparent        = ' '
+
+cellColor :: Cell -> Maybe (CA.Color, CA.ColorIntensity)
+cellColor (CellChar _ _ _ k) = k
+cellColor Transparent        = Nothing
+
+isBold :: Cell -> Bool
+isBold (CellChar _ b _ _) = b
+isBold _                  = False
+
+isReversed :: Cell -> Bool
+isReversed (CellChar _ _ r _) = r
+isReversed _                  = False
+
+-- | A String (@\n@ divided and ended) representing the 'Plane'. Useful
+-- for debugging/testing purposes.
+planePaper :: Plane -> String
+planePaper p = unlines . LS.chunksOf w . map cellChar $ elemsPlane p
+    where
+          w :: Int
+          w = fromIntegral . fst . planeSize $ p
+
+-----------------
+-- ANCILLARIES --
+-----------------
+
+stringPlaneGeneric :: Maybe Char -> String -> Plane
+stringPlaneGeneric _ "" = makeTransparent ' ' (blankPlane 1 1)
+stringPlaneGeneric mc t = vitrous
+    where
+          lined = lines t
+
+          h :: Int
+          h = length lined
+
+          w :: Int
+          w = maximum (map length lined)
+
+          pad :: Int -> String -> String
+          pad mw tl = take mw (tl ++ repeat ' ')
+
+          padded :: [String]
+          padded = map (pad w) lined
+
+          celled :: [Cell]
+          celled = map creaCell . concat $ padded
+
+          plane :: Plane
+          plane = listPlane (h, w) celled
+
+          vitrous :: Plane
+          vitrous = case mc of
+                      Just c  -> makeTransparent c plane
+                      Nothing -> plane
+

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Random.hs

@@ -0,0 +1,20 @@
+module Terminal.Game.Random ( R.StdGen,
+                              R.UniformRange,
+                              R.getStdGen,
+                              R.mkStdGen,
+                              getRandom,
+                              pickRandom )
+            where
+
+import System.Random as R
+
+
+-- | Simple, pure pseudo-random generator.
+getRandom :: UniformRange a => (a, a) -> StdGen -> (a, StdGen)
+getRandom bs sg = uniformR bs sg
+
+-- | Picks at random from list.
+pickRandom :: [a] -> StdGen -> (a, StdGen)
+pickRandom as sg = let l = length as
+                       (a, sg') = getRandom (0, l-1) sg
+                   in (as !! a, sg')

vendored/ansi-terminal-game-1.8.0.0/src/Terminal/Game/Timer.hs

@@ -0,0 +1,3 @@
+module Terminal.Game.Timer (module T) where
+
+import Control.Timer.Tick as T

vendored/ansi-terminal-game-1.8.0.0/test/Terminal/Game/DrawSpec.hs

@@ -0,0 +1,68 @@
+module Terminal.Game.DrawSpec where
+
+import Test.Hspec
+import Terminal.Game.Plane
+import Terminal.Game.Draw
+import Terminal.Game -- language hyphenators
+
+
+spec :: Spec
+spec = do
+
+  describe "mergePlanes" $ do
+    it "piles multiple planes together" $
+      mergePlanes (stringPlane "aa")
+                  [((1,2), cell 'b')] `shouldBe` stringPlane "ab"
+    it "works in the middle too" $
+      mergePlanes (stringPlane "aaa\naaa\naaa")
+                  [((2,2), cell 'b')] `shouldBe`
+                    stringPlane "aaa\naba\naaa"
+
+  describe "textBox/textBoxLiquid" $ do
+    let s  = "las rana in Spa"
+        w  = 6
+        ps = textBox w 2 s
+        pl = textBoxLiquid w s
+    it "textBox follows specific size" $
+      planeSize ps `shouldBe` (6, 2)
+    it "textBoxLiquid fits the whole string" $
+      planeSize pl `shouldBe` (6, 3)
+    it "textBox should make a transparent plane" $
+      let p1 = textBox 6 1 "a c e "
+          p2 = textBox 6 1 " b d f"
+          pc = p1 & (1, 1) % p2
+      in planePaper pc `shouldBe` "abcdef\n"
+
+  describe "textBoxHypen" $ do
+    let tbh = textBoxHyphen spanish 8 2 "Con pianito"
+    it "hyphens long words" $
+      planePaper tbh `shouldSatisfy` elem '-'
+
+  describe "***" $ do
+    let a  = stringPlane ".\n.\n.\n"
+        b  = stringPlane "*"
+        c  = stringPlane ".\n*\n.\n"
+    it "blits b in the centre of a" $
+      a *** b `shouldBe` c
+
+  -- combinators
+
+  let sp = stringPlane "ab"
+      bp = blankPlane 4 3
+
+  describe "%^>" $ do
+    it "blits in the top right corner" $
+      planePaper (bp & (1,1) %^> sp) `shouldBe` "  ab\n    \n    \n"
+
+  describe "%_<" $ do
+    it "blits in the bottom left corner" $
+      planePaper (bp & (2,1) %.< sp) `shouldBe` "    \nab  \n    \n"
+
+  describe "%_<" $ do
+    it "blits in the bottom left corner" $
+      planePaper (bp & (2,3) %.> sp) `shouldBe` "    \nab  \n    \n"
+
+  describe "%" $ do
+    it "mixes with alternative combinators" $
+      planePaper (bp & (1,2) % sp & (2,3) %.> sp) `shouldBe`
+        " ab \nab  \n    \n"